COMMENT ⊗   VALID 00051 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00005 00002	Definitions.
C00008 00003	More definitions.
C00013 00004	Storage allocations for statistics keeping.
C00017 00005	Storage allocations.
C00023 00006	Initialization.
C00026 00007	Initialization.
C00030 00008	Initialization.
C00032 00009	Start of main loop: asking for keywords.  (RESET,RSTART,APE1)
C00034 00010	Check for various kinds of keyword expressions.
C00036 00011	Set up main story list and report nbr of stories found.
C00040 00012	Read in story selection line.
C00043 00013	Process rest of selection line.
C00046 00014	Read in story selection numbers and build up sublist of selected stories.
C00048 00015	Build up a list of the stories selected.
C00050 00016	Finish building up story sublist.
C00055 00017	LOOKUP output file to see if it already exists, then ENTER it.
C00058 00018	Read in the stories found:   TYPEM
C00060 00019	Allow choosing stories.  TYP7    TYP14   TYP10
C00063 00020	Put story into output file.  TYP9    TYPE1
C00066 00021	Get next story in list.  TYP18   GETNXT  DIR8
C00069 00022	TERM    MINUS   PLUS    FACTOR  PRIMAR  INTRPT  CINT    ESCI    REENT
C00073 00023	GETWD
C00076 00024	FOUND   FINWD
C00078 00025	NONE    NOTFND  NOMULT  ASKSRC
C00080 00026	READWD
C00083 00027	READ    READY   GETCH
C00086 00028	GETAVL  NUNAVL  GTORIG
C00089 00029	ADORIG  RETLST
C00092 00030	SETUP   NEXT1   NEXT2
C00094 00031	SDIFF
C00095 00032	UNION
C00096 00033	INTER
C00097 00034	COPY1   COPY2   FINISH
C00099 00035	LATEST  SEQNBR
C00103 00036	GETSTY  INNBR   RDNBR   PTZERO  PRNTNO  NXTDG   PTREST
C00105 00037	PUTDAT  CLEARU
C00107 00038	GETDAT  PTIME
C00109 00039	PRINTU
C00111 00040	ZEROUS
C00112 00041	SAVPPN
C00114 00042	READIT
C00118 00043	SEARCH
C00122 00044	LOOK
C00128 00045	SHRINK  UUCODE
C00130 00046	TELLKY  TELLSL  TELLSC
C00140 00047	NOTE
C00146 00048	NOTEDP
C00150 00049	TYKEYS
C00152 00050	READFL  RFAUTO  RFCON
C00159 00051	RFERR1-5        RFNAME
C00161 ENDMK
C⊗;
;Definitions.

	TITLE APE

EXTERN	SPOOLM,JOBREN,JOBAPR,JOBFF,JOBSA

;ACCUMULATOR ASSIGNMENTS
F←←0		;AC0 contains flags in the left half and "@" in the right half
A←1		;temporary AC
SORPTR←2	;pointer into list of keywords (SORDID)
TXTPTR←3	;pointer into block for storage of characters of keywords
D←3		;temporary AC
B←4		;temporary AC
CNT←4		;counter
CHAR←6		;current tty input character
C←7		;temporary AC
DICTWD←10	;pointer to current DICT entry
PART1←11	;first 5 chars of keyword
PART2←12	;next 5 chars of keyword
PART3←13	;next 5 chars of keyword
PART4←14	;next 5 chars of keyword
X←11		;pointer into the INDEX file
DISPL←12	;displacement of current story in NEWS from record boundary
SIZE←14		;size of the current news story
LIST1←11	;first operand (list of stories) in a set operation
LIST2←12	;second operand (list of stories) in a set operation
LIST3←13	;resultant list of stories in a set operation
X1←14		;index of current story in first list
X2←15		;index of current story in second list
FIRST←16	;pointer to first part of keyword in WORDS (points to prev word)
STYPTR←16
P←17		;push down list pointer

LF←←12  CR←←15  FF←←14  ALT←←175  TAB←←11

SPECS←←4		;the next 7 lines must be duplicated in most AP programs
XSIZE←←3
MAXNBR←←=500
XLEN←MAXNBR*XSIZE+SPECS
WLEN←←6400
LLEN←←10000
DLEN←←6000		;last line that must be duplicated

SLSTLN←←=750		;length of the story list array (STYLST)
SLEN←←=64		;length of the SORDID array
PDLEN←←=100		;length of the pdl
STLEN←←2200		;length of the block for holding stories in core

DEFINE UNDUNX {INDEX}	;first word in INDEX file
DEFINE NEWX {INDEX+1}	;second word
DEFINE OLDX {INDEX+2}	;third word
;More definitions.

;LEFT HALF FLAGS
DONT  ←←      1	; 0 if the stories should be typed out, 1 if they should not be
SPOOL ←←      2	; 1 if output file should be spooled
SAVFIL←←      4	; 1 if the output file should be saved
OP1FLG←←     10	;bits indicating what kind of lists the operands are in a set
OP2FLG←←     20	;  operation.  1 means ptr into STYLST, 0 means ptr into LINKS.
XTND  ←← OP1FLG	; 1 if the user wants output file added to (extended) with stories
REPL  ←← OP2FLG	; 1 if the user wants output file to replace any file of same name
MINUS1←←     40	; 1 if the 1st story number was preceeded by a minus sign
MINUS2←←    100	; 1 if the 2nd story number was preceeded by a minus sign
PAIR  ←←    200	; 1 if two story selection numbers were typed in
ORDER ←←    400	; 1 if the stories are to come out in reversed order
FEW   ←←   2000	; 1 if the user wants only the first few lines of each story
CHOOSE←←   4000	; 1 if the user wants to choose if he wants to read rest of story
LSTFEW←←  10000	; 1 if the user wants only the last few lines of each story
SEL   ←←  20000	; 1 if the user has already made a story selection from current list
SELNUN←←  40000 ; 1 if the user wants has selected none of the stories
KEYS  ←← 100000 ; 1 if the user wants the keywords for each story typed out
NOTIFY←← 400000	; 1 if the user wants to be notified when a story matches his expr
TYPOUT←  DONT!SPOOL!SAVFIL!FEW!LSTFEW!CHOOSE

;RIGHT HALF FLAGS (CANT USE LOW ORDER 7 BITS!)
GOD   ←← 400000	; 1 if the user is AP,SYS
PPNDUN←← 100000	; 1 if the user's ppn has been written in the USERS file
INFILE←←  40000 ; 1 if there is a command file open
CON   ←←  20000 ; 1 if there is a command file open and the last expr ended with ","
AUTOCN←←  10000 ; 1 if keyword exprs should automatically be taken from cmd file
AUTOSC←←   4000 ; 1 if unrecognized keywords should automatically be searched for
TYPEFL←←   2000 ; 1 if stuff read from command file should be typed out
FROMFL←←   1000	; 1 if last keyword expression was read from a command file
;UNUSABLE←← 177

	LOC	41
	JSR	UUCODE
	LOC

OPDEF	UERR1	[001000,,];minor error.  type out message and jump to APE1
OPDEF	UERR2	[002000,,];moderate error.  type out message and jump to RSTART
OPDEF	UERR3	[003000,,];big error.  type out message and jump to RESET
OPDEF	UBIGERR	[004000,,];horrendous error.  type out message and exit
DEFINE	MEDERR(MSG) <UERR2 [ASCIZ\MSG\]>
DEFINE	LGEERR(MSG) <UERR3 [ASCIZ\MSG\]>

DEFINE	ECHOFF	{PTYUUO 16,[0↔3]}	;PTJOBX--this turns off echoing of type-in
DEFINE	ECHON	{PTYUUO 16,[0↔4]}	;this turns it back on
;Storage allocations for statistics keeping.

DEFINE NAMES {

	XXX	URAPE ,TIMES "R APE" TYPED.....................
	XXX	UEXPR ,NORMAL EXPRESSIONS......................
	XXX	UNULL ,NULL EXPRESSIONS..................(CR)..
	XXX	USTAR ,CONTINUED EXPRESSIONS..............(*)..
	XXX	UPLUS ,CONTINUED EXPRESSIONS..............(+)..
	XXX	UMINUS,CONTINUED EXPRESSIONS..............(-)..
	XXX	UCONLF,EXPRESSIONS CONTINUED.............(LF)..
	XXX	UNOTIF,NOTIFICATION REQUESTS..............($)..
	XXX	UNDSPY,NOTIFICATION REQUESTS DISPLAYED....($)..
	XXX	UNSTOP,NOTIFICATION REQUESTS DELETED...........
	XXX	UATFL ,COMMAND FILES REFERENCED...........(@)..
	XXX	UFLXP ,COMMAND FILE EXPRESSIONS USED...........
	XXX	UFLSL ,COMMAND FILE SELECTION LINES............
	XXX	UTYP  ,WHOLE STORIES TYPED OUT.................
	XXX	UFEW  ,FIRST FEW LINES TYPED OUT..........(F)..
	XXX	UCHSF ,STORIES CHOSEN FROM................(C)..
	XXX	UCHS  ,STORIES CHOSEN..........................
	XXX	ULST  ,LAST FEW LINES TYPED OUT...........(L)..
	XXX	USPL  ,STORIES SPOOLED....................(S)..
	XXX	UFIL  ,STORIES SAVED IN FILES.......(filenm←)..
	XXX	UKEYS ,TIMES KEYWORDS TYPED OUT...........(W)..
	XXX	UUNREC,UNRECOGNIZED KEYWORDS (NO SEARCH).......
	XXX	USCH  ,NUMBER OF SEARCHES DONE.................

}

DEFINE XXX(A,B) <
A:	0
>

LOCDAT:	BLOCK	3	;0)DSKTIM.  1)CPUTIM.  2)SRCTIM.
	NAMES
	0		;extra word because of dump mode bug (losing 4 bits)
ULEN←←.-LOCDAT
TOTDAT:	BLOCK	ULEN
CPUTIM←←1
SRCTIM←←2

DEFINE XXX(A,B) <
	[ASCIZ \B\]
>

MSGDAT←.-3
	NAMES		;block of ptrs to ASCIZ strings for data in USE.DAT

USEF:	SIXBIT	/USE2/
	SIXBIT	/DAT/
	BLOCK	2
UCMD:	IOWD	ULEN,TOTDAT
	0

MONTHS:	FOR MON IN (Jan,Feb,Mar,Apr,May,June,July,Aug,Sept,Oct,Nov,Dec)
<	ASCIZ \MON\
>

;USERS file contains a list of programmer names of people who have used APE
USERSF:	SIXBIT	/USERS/
	BLOCK	3
PCMD:	IOWD	1,USERS
	0
;USERS:			;the USERS block is common with the STORY block
USRPPN:	0
;Storage allocations.
			COMMENT ⊗  I/O CHANNELS USED
0:DICT
1:LINKS
2:INDEX
3:WORDS
4:NEWS
5:output file for news
7:interlock file: NOTIF.TMP
10:input of NOTIF for displaying/stopping requests
11:NOTIF.ADD--RA mode (unimplemented)
12:input command file
13:tty (output from message file)
14:USERS
15:USE.DAT (input)
16:USE.DAT (output)
17:APMESS (message file)	end of comment ⊗

NEWSF:	SIXBIT	/NEWS/
	BLOCK	3
INDEXF:	SIXBIT	/INDEX/
	BLOCK	3
LINKSF:	SIXBIT	/LINKS/
	BLOCK	3
DICTF:	SIXBIT	/DICT/
	BLOCK	3
WORDSF:	SIXBIT	/WORDS/
	BLOCK	3
MESSF:	SIXBIT	/APMESS/
	BLOCK	3
FILE:	0		;ENTER block for file to which some news stories are
	SIXBIT	/AP/	;	to be outputted.  Always given the extension .AP
	BLOCK	2
NOTIFF:	SIXBIT	/NOTIF/
	BLOCK	3
USERS:			;USERS and TMPBUF blocks are the same (common) to save space
TMPBUF:	BLOCK	230
STORY:	BLOCK	STLEN	;block for holding text of a story in core
RQBUF←STORY+200
INDEX:	BLOCK	XLEN	;block for holding entire INDEX file
LINKS:	BLOCK	LLEN	;block for holding entire LINKS file
DICT:	BLOCK	DLEN	;block for holding entire DICT file
WORDS:	BLOCK	WLEN	;block for holding entire WORDS file
SORDID:	BLOCK	SLEN	;block of headers for story lists
PDLIST:	BLOCK	PDLEN	;area for push down list
STYLST:	BLOCK	SLSTLN	;block for pointers to the stories found
POLLEN←←40
POLISH:	BLOCK	POLLEN	;right polish for keyw expr--used with auto notif
MBUF:	BLOCK	3	;header for buffer for message file
TBUF:	BLOCK	3	;header for buffer for TTY output from message file
DIGITS:	BLOCK	4

CMD:	IOWD	1,STORY
	0
XCMD:	IOWD	XLEN,INDEX
	0
LCMD:	IOWD	LLEN,LINKS
	0
DCMD:	IOWD	DLEN,DICT
	0
WCMD:	IOWD	WLEN,WORDS
	0
FCMD:	IOWD	1,STORY		;dump mode command for writing out selected stories
	0			;	on a file
NCMD:	IOWD	1,RQBUF
	0
DSK17:	17			;OPEN block for initing the dsk in mode 17
	SIXBIT	/DSK/
	0
TOTAL:	0			;count of the total number of stories found
FLBPTR:	0			;byte ptr for storing sixbit filename in FILE
PPN:	SIXBIT	/ APSYS/	;ppn for all the AP system files
AVSLST:	0			;ptr to first element in list of available STYLST slots
HEAD1:	0			;ptr to first element in first story list in set operation
HEAD2:	0			;ptr to first element in second story list in set operation
NFOUND:	0			;total number of stories found in current story list
FSTNBR:	0			;relative number of selected beginning story
SCDNBR:	0			;relative number of selected ending story
HEADER:	0			;header for the sublist of stories selected
SAVNBR:	0			;place for saving in ASCII the nbr of stories found
NBRGON:	0			;place for counting nbr of stories that have disappeared
LINEBP:	0			;byte ptr into a command line typed in
BRCHAR:	0			;char causing activation at end of typed in line
KSTART:	0			;byte ptr to start of current keyword in keyword expr
POLPTR:	0
SMINUS:	-1,,2
SPLUS:	-1,,1
SSTAR:	-1,,0
CRLF:	ASCIZ/
/
CRLFS:	ASCIZ/

/
RAPED:	-1			;counter of number of times user started APE
SEQBEG:	0			;starting sequence number of group
SEQEND:	0			;ending sequence number of group
STARS:	ASCIZ /************************************************************


/
STARLN←←.-STARS
;Initialization.
APE:	MOVE	P,[IOWD PDLEN,PDLIST]
	PUSHJ	P,CLEARU
	SETZ	A,
	CALLI	A,27		;RUNTIM
	MOVEM	A,LOCDAT+CPUTIM	;save run time at start up of ape
	CALLI	0		;RESET world
	MOVEI	F,"@"		;clear all flags and put "@" byte into AC
MAXT←←=45
	MOVEI	B,MAXT		;max length of time we try to lookup DICT
OPNDCT:	OPEN	0,DSK17		;DICT file
	UBIGERR	4	;	;OPEN FAILED ON DSK
	MOVE	A,PPN
	MOVEM	A,DICTF+3
	LOOKUP	0,DICTF
	JRST	[RELEAS	0,
		 CAIL	B,MAXT
		 OUTSTR	[ASCIZ /One moment please.../]
		 MOVEI	A,1
		 CALLI	A,31		;SLEEP a sec
		 SOJGE	B,OPNDCT
		 UBIGERR 10]	;	;could not LOOKUP DICT for MAXT secs
	HLRE	A,DICTF+3	;get size of DICT
	CAMGE	A,[-DLEN]
	UBIGERR	14	;	;DICT IS TOO BIG TO FIT INTO ITS ARRAY
	MOVNM	A,DICLEN#	;save size of dictionary
	HRLM	A,DCMD		;put size into dump mode command for DICT
	IN	0,DCMD
	JRST	.+2
	UBIGERR	20	;	;IN UUO FAILED TO READ IN DICT

	OPEN	1,DSK17		;LINKS file
	UBIGERR	24	;	;OPEN FAILED ON DSK
	MOVE	A,PPN
	MOVEM	A,LINKSF+3
	LOOKUP	1,LINKSF
	UBIGERR	30	;	;LOOKUP FAILED ON LINKS
	IN	1,LCMD
	JRST	.+2
	UBIGERR	34	;	;IN UUO FAILED TO READ IN LINKS
	RELEAS	1,

	OPEN	2,DSK17		;INDEX file
	UBIGERR	40	;	;OPEN FAILED ON DSK
	MOVE	A,PPN
	MOVEM	A,INDEXF+3
	LOOKUP	2,INDEXF
	UBIGERR	44	;	;LOOKUP FAILED ON INDEX
	IN	2,XCMD
	JRST	.+2
	UBIGERR	50	;	;IN UUO FAILED TO READ IN INDEX
	RELEAS	2,
;Initialization.

	OPEN	3,DSK17		;WORDS file
	UBIGERR	54	;	;OPEN FAILED ON DSK
	MOVE	A,PPN
	MOVEM	A,WORDSF+3
	LOOKUP	3,WORDSF
	UBIGERR	60	;	;LOOKUP FAILED ON WORDS
	IN	3,WCMD
	JRST	.+2
	UBIGERR	64	;	;IN UUO FAILED TO READ IN WORDS
	RELEAS	3,
	RELEAS	0,		;keep the DICT file open until all files have been read in

	INIT	17,10		;type out the file APMESS if it exists
	SIXBIT	/DSK/
	MBUF
	UBIGERR	70	;	;CANT INIT THE DSK
	MOVE	A,PPN
	MOVEM	A,MESSF+3
	LOOKUP	17,MESSF	;is there a message file to be typed out?
	JRST	NOMESS		;no
	OUTSTR	CRLF
	INIT	13,10
	SIXBIT	/TTY/
	XWD	TBUF,0
	UBIGERR	74	;	;CANT INIT THE TTY
	UOUTBF	13,[2↔201]
	PUSHJ	P,GMSWD		;get first word of file
	CAME	A,[ASCII/COMME/];is it a TV file?
	JRST	SOSMES		;no
	PUSHJ	P,PMSWD
	PUSHJ	P,GMSWD
	CAME	A,[ASCII/NT ⊗ /]
	JRST	SOSMES		;not TV file
	GETSTS	13,B
	TRO	B,20		;INHIBIT SYSTEM WORD COUNT
	SETSTS	13,(B)
FINDFF:	PUSHJ	P,GMSRC
	LDB	CHAR,[POINT 7,A,6];get first char of record
	CAIE	CHAR,FF		;FF marks end of TV directory page
	JRST	FINDFF
	TLZ	A,774000	;zero out the FF
	MOVEM	A,@MBUF+1
NXREC:	HRLZ	B,MBUF
	HRR	B,TBUF
	AOBJN	B,.+1
	MOVEI	C,(B)
	BLT	B,200(C)	;move from DSK buffer to TTY buffer
	HRRZS	(C)		;zero out left half of word count word
	OUTPUT	13,		;write out TTY buffer
	PUSHJ	P,GMSRC		;get next record of file
	JRST	NXREC

SOSMES:	TRNN	A,1		;is this word an SOS line number?
	JRST	SOS1		;no
	PUSHJ	P,GMSWD		;yes.  ignore it and get next word from file
	TLZ	A,774000	;zero out the tab following the line number
SOS1:	PUSHJ	P,PMSWD		;write out this word
	PUSHJ	P,GMSWD		;get next word from file
	JRST	SOSMES

PMSWD:	SOSG	TBUF+2		;put word into TTY buffer
	OUTPUT	13,
	IDPB	A,TBUF+1
	POPJ	P,

GMSWD:	SOSG	MBUF+2
GMSRC:	IN	17,		;get next record (buffer) from message file
	JRST	[ILDB A,MBUF+1	;get word from buffer
		 POPJ P,]
	SUB	P,[1,,1]
	RELEAS	13,		;TTY
NOMESS:	RELEAS	17,		;message file
	PUSHJ	P,SHRINK	;release any extra core accumulated
;Initialization.

	MOVEI	A,INTRPT
	MOVEM	A,JOBAPR	;set up address of interrupt module
	HRLZI	A,4		;enable for interrupts on [ESC] I
	CALLI	A,400025	;INTENB
	MOVEI	A,REENT
	MOVEM	A,JOBREN	;set up reentry address
	AOSN	RAPED		;add one to count of number of restarts
	AOS	URAPE		;bump "r ape" count first time only
	SETZ	A,
	CALLI	A,24		;GETPPN
	MOVEM	A,USRPPN
	HRRZ	B,A
	CAME	A,PPN
	CAIN	B,' ME'
	TROA	F,GOD
NOSPEC:	PUSHJ	P,SAVPPN
;Start of main loop: asking for keywords.  (RESET,RSTART,APE1)

	OUTSTR	[ASCIZ /
Type ? and RETURN at any time for help.
/]
;								    $
RESET:	MOVE	A,[XWD -SLSTLN+2,STYLST];clear the current story list and
	HRRZM	A,AVSLST		;	return all words of STYLST array
	ADDI	A,1			;	to the available space list
	HRRZM	A,-1(A)
	AOBJN	A,.-1
	SETZM	-1(A)			;put null ptr at end of available list
	SETZM	SORDID			;clear ptr to current story list
	SETZM	HEADER			;clear header to current story sublist
RSTART:	MOVE	P,[IOWD PDLEN,PDLIST]	;reset the pdl pointer (eg, after errors)
APE1:	INSKIP				;reset any printout stop (↑O)
	JFCL
	SETZ	SORPTR,			;point to header of current story list
	SETOM	POLPTR			;set length of polish expression to zero
	TDZ	F,[TYPOUT!NOTIFY,,AUTOSC!FROMFL];clear some flags
	OUTSTR	[ASCIZ /

KEYWORD EXPRESSION: /]			;ask for keywords expression

	TRNE	F,AUTOCN
	TRNN	F,INFILE
	JRST	KEY5
	PUSHJ	P,RFAUTO
	JRST	APE1
	JRST	KEY6

KEY5:	TRNN	F,GOD!PPNDUN
	PUSHJ	P,SAVPPN		;put PPN in USERS file
	TRNN	F,GOD
	PUSHJ	P,PUTDAT		;record usage data
	PUSHJ	P,READ			;read in keyword expression
KEY1:	MOVEI	CHAR,LF
	CAME	CHAR,BRCHAR
	JRST	KEY2
	OUTCHR	[":"]
	AOS	UCONLF
	MOVEI	CHAR," "
	DPB	CHAR,B
	PUSHJ	P,READ1
	JRST	KEY1
;Check for various kinds of keyword expressions.
KEY2:	PUSHJ	P,GETCH			;get first char of expr into CHAR
	CAIN	CHAR,"?"
	JRST	TELLKY			;wants some help!!
	CAIE	CHAR,"@"
	JRST	KEY4
	PUSHJ	P,READFL
	JRST	APE1
KEY6:	PUSHJ	P,GETCH
	TRNN	F,INFILE
	JUMPE	CHAR,APE1
	TRO	F,FROMFL		;indicate expression read from command file
	AOS	UFLXP
KEY4:	JUMPN	CHAR,KEY3		;is keyword expression null?
	AOS	UNULL			;yes
	JRST	APE2			;CR. use current story list
KEY3:	CAIN	CHAR,"+"		;does expression start with "+"?
	JRST	[PUSHJ	P,PLUS		;yes. perform union with current story list
		 AOS	UPLUS
		 JRST	CHECK]
	CAIN	CHAR,"-"		;does expression start with "-"?
	JRST	[PUSHJ	P,MINUS		;yes. perform set difference from current story list
		 AOS	UMINUS
		 JRST	CHECK]
	CAIN	CHAR,"*"		;does expression start with "*"?
	JRST	[PUSHJ	P,INTER		;yes. perform intersection with current story list
		 PUSHJ	P,TERM2
		 AOS	USTAR
		 JRST	CHECK]
	CAIN	CHAR,"$"
	PUSHJ	P,[TLO F,NOTIFY		;wants to be notified
		   JRST GETCH]
	JUMPE	CHAR,NOTEDP		;just $ means display notification requests
	PUSHJ	P,TERM			;read in a whole keyword expression
	AOS	UEXPR
;Set up main story list and report nbr of stories found.

CHECK:	JUMPE	CHAR,.+2		;zero means have processed whole expression
	MEDERR	(SYNTAX ERROR)	;	;there were some chars after the TERM
	HRRE	LIST1,SORDID(SORPTR)	;get ptr to first element in final story list
	JUMPGE	LIST1,APE2		;is story list a list in LINKS?
	MOVN	LIST1,LIST1		;yes.  copy it into STYLST
	HRRZ	X1,LINKS+1(LIST1)	;	get index ptr to first story
	MOVEI	LIST3,SORDID(SORPTR)	;	set up in LIST3 a ptr to prev list element
	TLZ	F,OP1FLG		;	indicate operand 1 is a list in LINKS
	SETZM	HEAD1			;	indicate no lists to be returned to
	SETZM	HEAD2			;		available STYLST storage
	PUSHJ	P,COPY1			;	actually copy the list into STYLST
APE2:
	JUMPE	SORPTR,APE8		;is old current story list being used?
	SKIPE	A,SORDID		;no.  is it null?
	PUSHJ	P,RETLST		;no.  return it to free storage
APE8:	HRRZ	LIST3,SORDID(SORPTR)	;get ptr to first element in story list
	HRRZM	LIST3,SORDID		;store it in header to current story list
	SETZ	CNT,			;initialize the count of stories to zero
	JUMPE	LIST3,NOMORE		;check for null list
APE3:	ADDI	CNT,1			;add 1 to count of stories
	HRRZ	LIST3,(LIST3)		;get ptr to next element in story list
	JUMPN	LIST3,APE3		;check if at end of list
NOMORE:	MOVEM	CNT,NFOUND		;save the number of stories found
	TLNE	F,NOTIFY		;notification requested?
	PUSHJ	P,NOTE			;yes.  write request on file
	SKIPG	PART1,NFOUND
	JRST	NONE			;no stories found
	MOVE	B,[POINT 7,DIGITS]
	SETZM	DIGITS
	PUSHJ	P,NXTDG
	MOVE	A,DIGITS
	MOVEM	A,SAVNBR		;save ascii of cnt in case of error
	JRST	ASK

CONERR:	OUTSTR	[ASCIZ/CONTRADICTORY SELECTIONS/]
ASKERR:	PUSHJ	P,PTREST
ASKER1:	TRZ	F,FROMFL!AUTOCN		;accept only one selection line from file
ASK:	OUTSTR	SAVNBR			;type out the number
	OUTSTR	[ASCIZ / news item(s) found.  Selection: /]
	TLZ	F,TYPOUT!ORDER!MINUS1!MINUS2!PAIR!SEL!SELNUN!KEYS;clear flags
	MOVE	A,NFOUND
	MOVEM	A,FSTNBR	;pretend user has choosen all stories

	TRC	F,INFILE!CON!FROMFL
	TRCE	F,INFILE!CON!FROMFL
	JRST	ASK2
	PUSHJ	P,RFCON
	JRST	ASKER1
	AOS	UFLSL
	JRST	ASK3
;Read in story selection line.

ASK2:	PUSHJ	P,READ			;read in whole line
ASK3:	ILDB	CHAR,LINEBP		;see if there is a file name specified?
	CAIN	CHAR,"?"
	JRST	TELLSL
	CAIE	CHAR,"←"
	JUMPN	CHAR,ASK3
	MOVE	A,[POINT 7,TMPBUF]
	MOVEM	A,LINEBP
	CAIE	CHAR,"←"		;is there a file name specified?
	JRST	ASK1			;no
	MOVE	A,[POINT 6,FILE]	;yes.  put it into LOOKUP/ENTER block
	MOVEI	B,6
	SETZM	FILE
	TLZ	F,XTND,REPL
	PUSHJ	P,GETCH
GFL1:	CAIN	CHAR,"←"
	JRST	GFL9
	CAIN	CHAR,"."
	JRST	GFL8
	CAIN	CHAR,"["
	JRST	GFL7
	CAIN	CHAR,"/"
	JRST	FLSWCH
	CAIG	CHAR,40
	JRST	GFL6
	SOJL	B,GFL5
	TRZ	CHAR,40			;convert file name char to sixbit
	TRZE	CHAR,100
	TRO	CHAR,40
	IDPB	CHAR,A			;save file name char
	ILDB	CHAR,LINEBP
	JRST	GFL1
GFL5:	OUTSTR	[ASCIZ/FILE NAME TOO LONG/]
	JRST	ASKERR
GFL6:	OUTSTR	[ASCIZ/ILLEGAL CHAR IN FILE NAME/]
	JRST	ASKERR
GFL7:	OUTSTR	[ASCIZ/PPN NOT ALLOWED/]
	JRST	ASKERR
GFL8:	OUTSTR	[ASCIZ/FILE NAME EXTENSION NOT ALLOWED/]
	JRST	ASKERR
FLSWCH:	PUSHJ	P,GETCH			;read in file switch
	CAIE	CHAR,"Q"
	CAIN	CHAR,"q"
	JRST	SETRPL			;wants to replace old file of same name
	CAIE	CHAR,"X"
	CAIN	CHAR,"x"
	JRST	SETXTD			;wants to extend old file
	JRST	SWERR
SETRPL:	TLOA	F,REPL
SETXTD:	TLO	F,XTND
	PUSHJ	P,GETCH
	CAIN	CHAR,"←"		;switch must be last part of file spec
	JRST	GFL9
SWERR:	OUTSTR	[ASCIZ/ILLEGAL FILE SWITCH/]
	JRST	ASKERR
GFL9:	SKIPE	FILE
	JRST	GFL10
	OUTSTR	[ASCIZ/NULL FILE NAME ILLEGAL/]
	JRST	ASKERR
GFL10:	TLO	F,SAVFIL
;Process rest of selection line.

CONTRA←  DONT!FEW!CHOOSE!LSTFEW!SELNUN!SPOOL!SAVFIL;more or less contradictory flags

ASK1:	PUSHJ	P,GETCH		;get next char of line
WHICH0:	JUMPE	CHAR,CLUNK	;zero means have found end of selection line
	CAIE	CHAR,"F"
	CAIN	CHAR,"f"
	JRST	[TLO F,FEW	;wants only the First few lines of each story
		TLNE F,CONTRA-(FEW!LSTFEW)
		JRST CONERR
		JRST ASK1]
	CAIE	CHAR,"C"
	CAIN	CHAR,"c"
	JRST	[TLO F,CHOOSE	;wants to Choose which stories he reads
		TLNE F,CONTRA-(CHOOSE!SPOOL!SAVFIL)
		JRST CONERR
		JRST ASK1]
	CAIE	CHAR,"L"
	CAIN	CHAR,"l"
	JRST	[TLO F,LSTFEW	;wants only the Last few lines of each story
		TLNE F,CONTRA-(LSTFEW!FEW)
		JRST CONERR
		JRST ASK1]
	CAIE	CHAR,"N"
	CAIN	CHAR,"n"
	JRST	[TLO F,SELNUN	;doesn't want to see any of the stories
		TLNE F,(SEL!CONTRA)-(SELNUN!DONT)
		JRST CONERR
		JRST ASK1]
	CAIE	CHAR,"S"
	CAIN	CHAR,"s"
	JRST	[TLO F,SPOOL	;wants stories selected to be spooled
		TLNE F,CONTRA-(SPOOL!CHOOSE!DONT!SAVFIL)
		JRST CONERR
		JRST ASK1]
	CAIE	CHAR,"W"
	CAIN	CHAR,"w"
	JRST	[TLO F,KEYS	;wants list of keywords for each story
		JRST ASK1]
	CAIE	CHAR,"D"
	CAIN	CHAR,"d"
	JRST	[TLO F,DONT	;doesn't want stories typed out
		TLNE F,CONTRA-(DONT!SPOOL!SAVFIL!SELNUN)
		JRST CONERR
		JRST ASK1]
	CAIE	CHAR,"K"
	CAIN	CHAR,"k"
	JRST	[TRZ F,AUTOCN	;wants to discontinue automatic reading
		JRST ASK1]	;	from command file
	CAIN	CHAR,"?"
	JRST	TELLSL		;wants some help!
;Read in story selection numbers and build up sublist of selected stories.

WHICH2:	CAIE	CHAR,"="	;does he want the order of the stories reversed?
	JRST	WHICH1		;no
	TLC	F,ORDER		;yes
	JRST	ASK1
WHICH1:	TLOE	F,SEL		;has he already made a story selection?
	JRST	SELERR		;yes.  some unknown stuff in selection line
	CAIE	CHAR,"-"
	JRST	WHICH3
	TLO	F,MINUS1	;set flag to indicate that 1st story nbr was negative
	PUSHJ	P,GETCH
WHICH3:	PUSHJ	P,GETSTY
	JUMPE	CNT,SELERR
	CAMLE	CNT,NFOUND	;has a nonexistent story been selected?
	JRST	NONEXS
	MOVEM	CNT,FSTNBR
	CAIE	CHAR,":"
	JRST	WHICH0
	TLO	F,PAIR		;set flag to indicate that a pair of nbrs were typed in
	PUSHJ	P,GETCH
	CAIE	CHAR,"-"
	JRST	WHICH7
	TLO	F,MINUS2	;set flag to indicate that 2nd story nbr was negative
	PUSHJ	P,GETCH
WHICH7:	PUSHJ	P,GETSTY
	JUMPE	CNT,SELERR
	CAMLE	CNT,NFOUND
	JRST	NONEXS
	MOVEM	CNT,SCDNBR
	JRST	WHICH0
NONEXS:	OUTSTR	[ASCIZ /STORY NUMBER TOO BIG: /]
	MOVE	PART1,CNT
	PUSHJ	P,PRNTNO
	OUTSTR	CRLF
	JRST	ASKER1
SELERR:	OUTSTR	[ASCIZ/SELECTION ERROR/]
	JRST	ASKERR
;Build up a list of the stories selected.

CLUNK:	TLNE	F,SELNUN	;has he selected none of the stories?
	JRST	APE1		;yup.  give him what he wants
	TLNE	F,DONT
	TLNE	F,SAVFIL!SPOOL!KEYS
	JRST	.+2
	JRST	APE1		;dont type, file, or spool!!
	TLNE	F,PAIR		;were a pair of story numbers typed in?
	JRST	HAVEPR		;yes
	TLNE	F,MINUS1	;no. did the story number have a minus sign?
	JRST	GETOLD		;yes
	MOVEI	A,1		;no. select the most recent FSTNBR stories
	EXCH	A,FSTNBR
	MOVEM	A,SCDNBR	;end with story number FSTNBR
	JRST	BUILD
GETOLD:	MOVE	A,NFOUND
	MOVEM	A,SCDNBR	;end with last story
	SUB	A,FSTNBR	;calculate the number of the FSTNBR oldest story
	ADDI	A,1
	MOVEM	A,FSTNBR	;store number of starting story
	JRST	BUILD

HAVEPR:	TLNN	F,MINUS1	;did the first story number have a minus sign?
	JRST	CHK2ND		;no.  see if the 2nd story did.
	MOVE	A,NFOUND	;yes
	SUB	A,FSTNBR	;calculate the number of the FSTNBR oldest story
	ADDI	A,1
	MOVEM	A,FSTNBR	;store number of starting story
CHK2ND:	TLNN	F,MINUS2	;did the second story number have a minus sign?
	JRST	BUILD		;no
	MOVE	A,NFOUND	;yes
	SUB	A,SCDNBR	;calculate the number of the SCDNBR oldest story
	ADDI	A,1
	MOVEM	A,SCDNBR	;store number of ending story
;Finish building up story sublist.

BUILD:	SKIPE	A,HEADER	;is there a non-null sublist sitting around?
	PUSHJ	P,RETLST	;yes. return it to free storage
	SETZM	HEADER
GRONK:	MOVE	A,FSTNBR	;load numbers of beginning and ending stories and
	MOVE	B,SCDNBR	;	build up sublist of those stories
	CAMG	A,B		;are oldest stories to come first?
	JRST	BUILD1		;no
	EXCH	A,B		;put number of lowest numbered story into A
	TLC	F,ORDER		;set flag indicating the list built up should be in rev order
BUILD1:	SUBI	B,-1(A)		;put number of stories to be collected into B
	HRRZ	LIST1,SORDID(SORPTR);get ptr to first element of whole list
BUILD2:	MOVE	LIST1,(LIST1)	;get the next element of the whole list
	SOJG	A,BUILD2	;have we reached the first story for the sublist?
	TLNE	F,ORDER		;yes. should the stories be collected in reverse order?
	JRST	BLDREV		;yes
	MOVEI	LIST3,HEADER	;get ptr to the header for the sublist
BUILD3:	PUSHJ	P,GETAVL	;put this story into the sublist
	HLLM	LIST1,(LIST3)	;put the index of this story into the sublist element
	MOVE	LIST1,(LIST1)	;get the next element of the whole list
	SOJG	B,BUILD3	;have we collected the necessary number of stories?
	HLLZS	(LIST3)		;yes.  put null ptr at end of sublist
	HRRZ	LIST3,HEADER	;load LIST3 with ptr to first element of sublist
	JRST	DOESHE
BLDREV:	SETZ	LIST3,		;make ptr to current sublist element null
REV3:	SKIPN	STYPTR,AVSLST	;get available word for reversed story list
	JRST	NUNAVL		;there are no available words for the story list!
	MOVE	A,(STYPTR)	;get ptr to 2nd available word and store it
	MOVEM	A,AVSLST	;	in header of available list
	HRRZM	LIST3,(STYPTR)	;put ptr to prev list element in new list element
	MOVE	LIST3,STYPTR	;put ptr to new element into LIST3
	HLLM	LIST1,(LIST3)	;put the index of this story into the sublist element
	MOVE	LIST1,(LIST1)	;get the next element of the whole list
	SOJG	B,REV3		;have we collected the necessary number of stories?
	HRRZM	LIST3,HEADER	;store ptr to the sublist for returning it to avail storage

DOESHE:	TLNN	F,SAVFIL!SPOOL	;is there to be an output file???
	JRST	TYPEM		;no
DIR2:	TLNE	F,SAVFIL	;does he want the news saved in a file?
	JRST	DIR5		;yes.  go lookup/enter file
	MOVE	A,[SIXBIT /$NEWS0/];initialize name for file to be spooled
DIR9:	MOVEM	A,FILE		;put file name in LOOKUP/ENTER block
	MOVE	B,USRPPN
	MOVEM	B,FILE+3	;put file to be spooled on user's real disk area
	OPEN	5,DSK17
	UBIGERR	110	;	;OPEN FAILED ON DSK
	LOOKUP	5,FILE		;does file already exist?
	JRST	DIR6		;no.  go do an ENTER on it
	RELEAS	5,		;yes.  increment special name and try again
	AOJA	A,DIR9
;LOOKUP output file to see if it already exists, then ENTER it.

DIR5:	OPEN	5,DSK17		;see if file specified already exists.
	UBIGERR	100	;	;OPEN FAILED ON DSK
	SETZM	FILE+3		;file will be on the users area
	TLNN	F,REPL
	LOOKUP	5,FILE
	JRST	DIR6		;file doesn't exist or should be replaced. ENTER it
	TLNE	F,XTND
	JRST	EXTEND
	OUTSTR	[ASCIZ /FILE ALREADY EXISTS!
Type Q to replace, X to extend, or just <return> for new selection line: /]
	PUSHJ	P,READ
	PUSHJ	P,GETCH
	CAIE	CHAR,"Q"
	CAIN	CHAR,"q"
	JRST	DIR6		;replace specified file
	CAIE	CHAR,"X"
	CAIN	CHAR,"x"
	JRST	EXTEND		;extend specified file
	RELEAS	5,
	CAIN	CHAR,"?"
FLQUES:	OUTSTR	[ASCIZ $
Follow the filename with /Q to have any old file of same name replaced
with a file containing the currently selected stories.
Follow the filename with /X to have any old file of same name extended
by adding the currently selected stories at the end of the old file.

$]
	JRST	ASKER1		;ask for another selection line

;Enter file for saving/spooling stories.
DIR6:	RELEAS	5,
	OPEN	5,DSK17		;do an ENTER on the output file for the news
	UBIGERR	104	;	;OPEN FAILED ON DSK
EXTEND:	HLLZS	FILE+1		;file gets standard extension .AP
	SETZM	FILE+2
	SETZM	FILE+3		;put file on user's disk area
	MOVE	B,USRPPN
	TLNN	F,SAVFIL	;is this file to be saved?
	MOVEM	B,FILE+3	;no.  put it on disk area of user's logged in ppn
	ENTER	5,FILE
	JRST	DIR14		;ENTER failed
	UGETF	5,B		;set file ptr to end of file
	JRST	TYPEM		;ENTER succeeded
DIR14:	RELEAS	5,
	TLNN	F,SAVFIL	;was the ENTER for a file only to be spooled?
	AOJA	A,DIR9		;yes. increment the name of the special spooling file
	OUTSTR	[ASCIZ /
ENTER failed on output file!
/]				;no. tell user that the ENTER failed on the file name he gave
	JRST	ASKER1		;go ask for another file name
;Read in the stories found:   TYPEM

TYPEM:	OUTSTR	CRLFS
	TLNN	F,KEYS
	TLNN	F,DONT		;type out row of stars before first story if typing
	OUTSTR	STARS
	SETZM	AMT#		;indicate nothing in overflow buffer
	SETZM	NBRGON		;zero out the counter of stories gone
	SETZM	INTFG		;clear [ESC] I flag
NXTSTY:	HLRZ	X,(LIST3)	;get index of current story in story list
	TLNE	F,KEYS		;does he want to see keywords for this story?
	PUSHJ	P,TYKEYS	;yes.  type them out
EXTRA:	PUSHJ	P,READIT	;read in the story
	JRST	[HRRE X,INDEX(X);story not found in NEWS
		 JUMPG X,EXTRA	;does story have a follow up?
		 AOS  NBRGON	;no.  count nbr of stories completely gone
		 JRST GETNXT]	;go on to next story
	SKIPE	INTFG
	JRST	ESCI
	TLNN	F,FEW		;does he want only first few lines of each story?
	JRST	TYP7		;no
	AOS	UFEW
	TLNE	F,LSTFEW	;does he also want the last few lines?
	JRST	TYP5		;yes
	MOVE	A,CRLFS		;no.  type out only the first few lines
	MOVEM	A,=50(DISPL)	;print only first =50 words (=250 chars)
	OUTSTR	(DISPL)		;type out the first few lines
	JRST	TYP8
TYP5:	MOVEI	B,=80		;type out only the first few and the last few lines
	CAML	B,TOTSIZ
	JRST	TYP4		;small story.  type out whole thing
	MOVE	A,CRLFS
	MOVEM	A,=50(DISPL)
	OUTSTR	(DISPL)
	JRST	TYP10
;Allow choosing stories.  TYP7    TYP14   TYP10

TYP7:	TLNN	F,CHOOSE	;does he want to choose which stories get typed out?
	JRST	TYP14		;no
	INSKIP			;reset ↑O
	JFCL
	AOS	UCHSF
	ECHOFF			;turn off echoing for choose response
	SETZ	A,
	EXCH	A,=50(DISPL)
	OUTSTR	(DISPL)		;type out first part of story
	SKIPE	INTFG
	JRST	CINT
	INCHWL	CHAR		;see what user wants to do now
	ECHON			;turn echoing back on
	CLRBFI
	CAIN	CHAR,CR		;just <CRLF> means dont type out rest of story
	JRST	[OUTSTR CRLFS↔JRST TYP18]
	CAIE	CHAR,"I"	; I <CRLF> means give up this fruitless process
	CAIN	CHAR,"i"
	JRST	CINT
	AOS	UCHS
	MOVEM	A,=50(DISPL)	;anything else means type out rest of story
	MOVEI	B,=50
	CAMGE	B,TOTSIZ
	OUTSTR	=50(DISPL)	;type out remainder
	JRST	TYP15

TYP14:	TLNN	F,LSTFEW	;does he want only the last few lines of each story?
	JRST	TYP6		;no
TYP10:	MOVEI	A,STORY-=25	;yes.  compute ptr to =25 words before end of story
	SUB	A,SIZE
	CAMGE	A,DISPL		;is this ptr in middle of story?
TYP4:	MOVE	A,DISPL		;no. must be a very short story. type it all out.
	OUTSTR	(A)
	AOS	ULST
	JRST	TYP8
TYP6:	TLNE	F,DONT		;does user want the story typed out?
	JRST	TYP15		;no
	OUTSTR	(DISPL)		;type out the story
	AOS	UTYP
TYP15:	TLNN	F,SAVFIL+SPOOL	;is there an output file?
	JRST	TYPE1		;no
;Put story into output file.  TYP9    TYPE1

TYP9:	MOVE	A,AMT		;get number of words left over last time
	MOVE	B,TOTSIZ	;get total size of current story
	ADD	B,A		;amount that now needs to be output
	MOVE	D,B
	ANDI	D,177		;amount that will be left over this time
	MOVEM	D,AMT		;save this nbr for next time
	ANDI	B,777600	;amount that will be output now (multiple of 200)
	JUMPE	B,FIL6		;any stuff going out now?
	MOVN	D,B		;yes
	JUMPN	A,FIL2		;was there any stuff left over from before?
	HRLI	D,-1(DISPL)	;no.  output from beginning of story
	JRST	FIL3
FIL2:	MOVSI	C,(DISPL)	;move main part of story up to end of
	HRRI	C,TMPBUF(A)	;	left over stuff
	BLT	C,TMPBUF-1(B)
	HRLI	D,TMPBUF-1	;output from beginning of left over stuff
FIL3:	MOVSM	D,FCMD
	OUT	5,FCMD		;write out the story on the output file
	JRST	.+2
	UBIGERR	114	;	;OUT UUO FAILED TO WRITE OUT A STORY ON A FILE
	ADD	DISPL,B
	SUB	DISPL,A
	SETZ	A,		;stuff left over from last time is now gone
FIL6:	HRLZ	DISPL,DISPL	;move new left over stuff to save it for next time
	HRRI	DISPL,TMPBUF(A)
	SKIPE	C,AMT		;if no left over stuff, no use moving it
	BLT	DISPL,TMPBUF-1(C)
	TLNE	F,SAVFIL
	AOS	UFIL		;increment number of stories filed
	TLNE	F,SPOOL
	AOS	USPL		;increment number of stories spooled

;Get follow-up story if any, else get next story.  Finish up.
TYPE1:	HRRE	X,INDEX(X)	;is this story linked up with a follow-up
	JUMPG	X,EXTRA		;	story of some kind?
	TLNE	F,DONT		;no.  is the news being typed out?
	TLNE	F,KEYS
	JRST	TYP8
	OUTCHR	["@"]		;no.  type out an "@" for each story writen on the file
TYP8:	TLNN	F,SAVFIL+SPOOL	;are the stories are being filed?
	JRST	TYP18		;no
	MOVE	A,AMT		;yes.  put a row of *'s in the file
	MOVSI	B,STARS
	HRRI	B,TMPBUF(A)
	BLT	B,TMPBUF+STARLN-1(A);move *'s into overflow buffer
	ADDI	A,STARLN
	MOVEM	A,AMT
;Get next story in list.  TYP18   GETNXT  DIR8

TYP18:	INSKIP			;reset typeout flag in case user typed ↑O
	JFCL
	SKIPE	INTFG
	JRST	ESCI
	TLNN	F,KEYS
	TLNN	F,DONT		;if the news is being typed out, separate stories
	OUTSTR	STARS		;	with a row of *'s
GETNXT:	HRRZ	LIST3,(LIST3)	;get ptr to next element in story list
	JUMPN	LIST3,NXTSTY	;if not at end of list, go back and process next story
	SKIPE	INTFG
	JRST	ESCI
	SKIPN	PART1,NBRGON
	JRST	DIR8
	PUSHJ	P,PRNTNO
	OUTSTR	[ASCIZ / OF THE STORIES WENT AWAY--SORRY

/]
DIR8:	TLNE	F,DONT			;the stories have now been outputted
	OUTSTR	CRLF			;	as requested
	TLNN	F,SPOOL+SAVFIL		;is there an output file?
	JRST	APE1			;no.  nothing left to do
	MOVN	A,AMT			;yes.  finish writing out file
	JUMPE	A,FIL4
	HRLI	A,TMPBUF-1	;set up dump mode command to output overflow buffer
	MOVSM	A,FCMD
	OUT	5,FCMD
	JRST	.+2
	UBIGERR	120	;	;OUT UUO FAILED TO OUTPUT OVERFLOW BUFFER
FIL4:	RELEAS	5,
	TLNN	F,SPOOL		;is the file to be spooled?
	JRST	APE1		;no
	HLLZS	FILE+1		;yes. zero the spooler flags
	SETZM	FILE+3		;use user's current disk ppn
	TLNE	F,SAVFIL	;should the file be deleted after spooling?
	JRST	FIL4B		;no
	MOVEI	A,1		;yes
	HRRM	A,FILE+1	;set the delete flag for spooler
	MOVE	A,USRPPN	;the spool file to be deleted is on disk area of
	MOVEM	A,FILE+3	;	the user's logged in ppn
FIL4B:	PUSHJ	P,SPOOLM	;spool the file
	JUMP	FILE		;ptr to data block for spooler
	JRST	APE1		;go back and get next set of keywords
;TERM    MINUS   PLUS    FACTOR  PRIMAR  INTRPT  CINT    ESCI    REENT

TERM:	PUSHJ	P,FACTOR	;term ::=  factor { [+|-] factor }
TERM2:	CAIN	CHAR,"+"	;	where [...] means choose one of ..., and
	JRST	PLUS		;	where {...} means ... may occur zero or more times
	CAIE	CHAR,"-"
	POPJ	P,
MINUS:	PUSHJ	P,SDIFF		;take the set difference of the two factors separated by -
	PUSHJ	P,SAVPOL
	SMINUS
	JRST	TERM2		;look for more +'s or -'s
PLUS:	PUSHJ	P,UNION		;take the union of the two factors separated by +
	PUSHJ	P,SAVPOL
	SPLUS
	JRST	TERM2		;look for more +'s or -'s

FACTOR:	PUSHJ	P,PRIMAR	;factor ::= primary { * factor }
	CAIE	CHAR,"*"	;	note: factors are intersected from right to
	POPJ	P,		;	left since in this case that's equivalent to left to right
	PUSHJ	P,INTER		;take the intersection of the primary and factor separated by *
	PUSHJ	P,SAVPOL
	SSTAR
	POPJ	P,		; (the pushj to INTER MUST be a pushj, not a jrst)

PRIMAR:	CAIE	CHAR,"("	;primary ::= keyword | ( term )
	JRST	GETWD		;no "(".  get a keyword.
	PUSHJ	P,GETCH		;found "(".  get next char.
	PUSHJ	P,TERM		;get term following "("
	CAIN	CHAR,")"	;check for ")" after term
	JRST	GETCH		;found ")".  get next char and return from PRIMAR
	MEDERR	(MISSING RIGHT PARENTHESIS)	;	;

INTRPT:	SETOM	INTFG#		;so he typed [ESC] I, did he...
	SETZM	STORY		;zero out any story in core to stop an outstr
	MOVE	A,[XWD STORY,STORY+1]
	BLT	A,STORY+STLEN-1
	CLRBFO
	CALLI	400024		;DISMIS

CINT:	ECHON			;make sure echoing is on!
ESCI:	OUTSTR	[ASCIZ /

↑I
/]				;user typed [ESC] I while typing out stories
REENT:	CLRBFI			;would you believe reentry address?
	RELEAS	4,		;let go of NEWS file!
	RELEAS	5,3		;throw away output file if open
	TRZ	F,AUTOCN	;disable automatic reading from command file
	JRST	RSTART
;GETWD

GETWD:	SETZM	ORIGHD
	ADDI	SORPTR,1		;make new entry in SORDID for story list for this keyword
	CAIN	CHAR,"."		;does this keyword specify the latest news?
	JRST	LATEST			;yes
	CAIN	CHAR,"#"		;does this "keyword" specify a certain seq nbr?
	JRST	SEQNBR			;yes.  collect all stories with given seq nbr
	MOVE	A,LINEBP
	MOVEM	A,KSTART		;save byte ptr to current keyword
	PUSHJ	P,READWD

CKNULL:	CAMN	PART1,[NULL: ASCII /@@@@@/];is the word null (has no characters)?
	MEDERR	(MISSING KEYWORD)	;	;
	SETZ	DICTWD,			;initialize ptr to just before 1st word in dictionary

NXTDWD:	ADDI	DICTWD,2		;advance DICTWD ptr to the next word in the dictionary
	HLRZ	FIRST,DICT(DICTWD)	;get ptr to the text of the dictionary word
	MOVE	A,CNT			;move length of typed-in keyword into A
;compare the typed-in keyword with the dictionary word
	CAME	PART1,WORDS(FIRST)	;method of comparison: compare 5 chars at a time
	JRST 	CK1			;	until either the two words differ or
	AOJGE	A,FOUND			;	the end of the typed-in keyword is
	CAME	PART2,WORDS+1(FIRST)	;	reached.  If the two words differ, check
	JRST	CK2			;	which comes first alphabetically.  If the
	AOJGE	A,FOUND			;	dictionary word comes first, go back and
	CAME	PART3,WORDS+2(FIRST)	;	get the next dictionary word.  If the
	JRST	CK3			;	typed-in word comes first, then it
	AOJGE	A,FOUND			;	isn't in the dictionary.
	CAMN	PART4,WORDS+3(FIRST)
	JRST	FOUND
CK4:	CAMG	PART4,WORDS+3(FIRST)
	JRST	NOTFND			;typed-in word not in the dictionary
	JRST	NXTDWD			;get the next dictionary word
CK3:	CAMG	PART3,WORDS+2(FIRST)
	JRST 	NOTFND
	JRST	NXTDWD
CK2:	CAMG	PART2,WORDS+1(FIRST)
	JRST	NOTFND
	JRST	NXTDWD
CK1:	CAMG	PART1,WORDS(FIRST)
	JRST	NOTFND
	JRST	NXTDWD
;FOUND   FINWD

FOUND:	PUSHJ	P,GETCH1
	PUSHJ	P,READWD
	CAMN	PART1,NULL
	JRST	FINWD
	HLRZ	DICTWD,DICT+1(DICTWD)

NXBRO:	JUMPE	DICTWD,NOMULT		; 0 means user wants mult key, but there is none
	HLRZ	FIRST,DICT(DICTWD)
	MOVE	A,CNT
	CAME	PART1,WORDS(FIRST)
	JRST	GETBRO
	AOJGE	A,FOUND
	CAME	PART2,WORDS+1(FIRST)
	JRST	GETBRO
	AOJGE	A,FOUND
	CAME	PART3,WORDS+2(FIRST)
	JRST	GETBRO
	AOJGE	A,FOUND
	CAMN	PART4,WORDS+3(FIRST)
	JRST	FOUND
GETBRO:	HRRZ	DICTWD,DICT+2(DICTWD)
	JRST	NXBRO

FINWD:	HRRZ	A,DICT+1(DICTWD)	;get ptr to first LINKS slot for this word
	CAIN	A,-1
	JRST	NOMULT
	MOVN	A,A
	HRRM	A,SORDID(SORPTR)	;	and store it negated with this keyword
	PUSHJ	P,SAVPOL
	DICTWD
	JRST	GETCH1			;skip any special chars after keyword (blanks, CR's, LF's, tabs

SAVPOL:	PUSH	P,A
	PUSH	P,B
	AOS	A,POLPTR
	CAIL	A,POLLEN
	HALT	.	;	;
	MOVE	B,@-2(P)
	MOVE	B,(B)
	MOVEM	B,POLISH(A)
	POP	P,B
	POP	P,A
	AOS	(P)
	POPJ	P,
;NONE    NOTFND  NOMULT  ASKSRC

NONE:	OUTSTR	[ASCIZ /NO NEWS ITEMS FOUND/]	;keywords had no associated news stories
	JRST	APE1

NOTFND:	CAME	PART1,[ASCII /FOO@@/]
	JRST	NOT1
	PUSHJ	P,PRINTU
	JRST	RSTART
NOT1:	CAMN	PART1,[ASCII /BAZ@@/]
	TRNN	F,GOD
	JRST	NOMULT
	PUSHJ	P,PRINTU
	PUSHJ	P,ZEROUS
	JRST	RSTART

NOMULT: PUSHJ	P,GETCH1
	PUSHJ	P,READWD
	CAME	PART1,NULL
	JRST	NOMULT

	AOS	A,POLPTR		;move text of unrec keyw into a buffer so
	CAIL	A,POLLEN		; that we can outstr it and search for it
	HALT	.	;	;
	ADDI	A,POLISH
	HRLI	A,700
	MOVEM	A,TMPBP#
	MOVEM	A,FSTBP#
	
	MOVE	B,KSTART
	LDB	A,B
	JRST	.+2
	ILDB	A,B
	IDPB	A,TMPBP
	CAME	B,LINEBP
	JRST	.-3
	SETZ	A,
	DPB	A,TMPBP

ASKSRC:	OUTSTR	[ASCIZ /Unrecognized keyword: /]
	HRRZ	A,FSTBP
	OUTSTR	1(A)
	TROE	F,AUTOSC
	JRST	LOOK0
	OUTSTR	[ASCIZ /.  Search? /]
	PUSHJ	P,READY
	JRST	LOOK			;"Y"
	JRST	TELLSC			;"?".  wants some help.
NOM1:	AOS	UUNREC			;any other char means no search
	JRST	RSTART
;READWD

READWD:	SETZ	PART1,
	SETZ	PART2,
	SETZ	PART3,
	SETZ	PART4,
	MOVEI	CNT,=20			;limit the number of chars in keyword to 20
	MOVE	TXTPTR,[POINT 7,PART1]	;initialize byte ptr to deposit chars in ACs PART1-4
NXTCHR:	CAIL	CHAR,"a"		;is current char a small letter?(less than"a"?)
	CAILE	CHAR,"z"		;maybe. Is it less than than "z"?
	JRST	NOTSML			;not a small letter
	TRZ	CHAR,40			;was a small letter. turn off 40 bit making it a cap letter
	JRST	GOTLTR
NOTSML:	CAIL 	CHAR,"0"		;is this char eligible to be in a keyword?
	CAILE	CHAR,"Z"
	JRST	RWD1			;no.  must be end of keyword
	CAILE	CHAR,"9"		;maybe.  does it come between "9" and "A"?
	CAIL	CHAR,"A"
	JRST	GOTLTR			;no.  must be a letter or a digit
	JRST	RWD1			;yes.  end of keyword
GOTLTR:	SOJL	CNT,.+2			;it is a letter.  has keyword already got 20 chars in it?
	IDPB	CHAR,TXTPTR		;no.  put current char in TEXT
	ILDB	CHAR,LINEBP		;get the next character
	JRST	NXTCHR
RWD1:	JUMPG	CNT,DEP100
	HRREI	CNT,-4			;put negated number of ACs holding keyword into CNT
	POPJ	P,
DEP100:	IDPB	F,TXTPTR		;deposit an "@" at end of keyword in PARTs
	SUBI	CNT,1
	TLNE	TXTPTR,760000		;byte ptr now pointing to low order byte in word?
	JRST	DEP100			;no.  go deposit another "@"
	IDIVI	CNT,5			;calculate negated number of ACs holding keyword
	SUBI	CNT,4
	POPJ	P,
;READ    READY   GETCH

READ:	MOVE	B,[POINT 7,TMPBUF];read in a line typed by the user
	MOVEM	B,LINEBP	;initialize byte ptr to beginning of line
READ1:	INCHWL	CHAR
	CAIN	CHAR,CR
	JRST	READ4
	CAIN	CHAR,LF
	JRST	READ3
	CAIN	CHAR,ALT
	JRST	READ2
	IDPB	CHAR,B		;save the char
	TRNN	CHAR,600	;is it an activation char?
	JRST	READ1		;no.  get next char
READ2:	OUTSTR	CRLF		;echo a CRLF when user types ALT or char with
	JRST	READ5		;	control bits on
READ3:	OUTCHR	[CR]		;echo a CR when user types LF
	JRST	READ5
READ4:	INCHWL	C		;read the LF of a user-typed CRLF
READ5:	MOVEM	CHAR,BRCHAR	;save the activation character
	SETZ	CHAR,		;place a zero byte after text string
	IDPB	CHAR,B
	POPJ	P,

;read in answer to yes/no question
READY:	PUSH	P,CHAR		;save CHAR
	PUSH	P,BRCHAR	;and BRCHAR
	PUSH	P,B		;and B
	MOVE	B,[POINT 7,STORY]
	PUSHJ	P,READ1
	POP	P,B
	POP	P,BRCHAR	;restore 'em
	POP	P,CHAR
	LDB	A,[POINT 7,STORY,6]
	CAIE	A,"Y"
	CAIN	A,"y"
	POPJ	P,		;direct return if answer is Yes
	AOS	(P)		;skip return otherwise
	CAIE	A,"?"
	AOS	(P)		;double skip return unless "?"
	POPJ	P,

GETCH:	ILDB	CHAR,LINEBP	;subroutine to put into CHAR the next char from
GETCH1:	CAIE	CHAR," "	;	the keyword expression that is not
	CAIN	CHAR,TAB	;	a space or a tab.
	JRST	GETCH
	POPJ	P,
;GETAVL  NUNAVL  GTORIG

GETAVL:	MOVE	STYPTR,AVSLST		;get available word for story list
	JUMPN	STYPTR,.+2
NUNAVL:	LGEERR	{STORY LIST SPACE EXCEEDED!  (TEMPORARY LISTS EXCEED 750 STORIES)}	;	;
	MOVE	A,(STYPTR)		;get ptr to 2nd available word and store it
	MOVEM	A,AVSLST		;	in header of available list
	HRRM	STYPTR,(LIST3)		;link up last element to this new element
	MOVE	LIST3,STYPTR		;leave ptr to new element in LIST3
	POPJ	P,

GTORIG:	HLRZ	X2,INDEX+2(X)		;is this story a follow up of another?
	JUMPN	X2,GTORG2
	MOVEI	C,ORIGHD		;no.  see if this story already on orig list
	JRST	GT0
GT1:	HLRZ	X1,(D)			;get index ptr of this list element
	CAMN	X,X1			;is it the same story?
	JRST	CPOPJ1			;yes.  nothing to do but skip
	MOVE	C,D			;no.  move down list
GT0:	HRRZ	D,(C)			;get ptr to next element in list
	JUMPN	D,GT1			;are we at end of orig list
	PUSHJ	P,GETAVL		;yes.  put this story at end of main list
	HRLM	X,(LIST3)
	POPJ	P,

GTORG2:	MOVEI	C,ORIGHD		;here we have the orig story of a follow up
	JRST	GTORG0			;  and we want to add story to orig list
GTORG1:	HLRZ	X1,(D)			;get index ptr of this list element
	CAMN	X2,X1			;is this the same story?
	JRST	CPOPJ1			;yes.  dont have to do anything. skip return
	MOVE	C,D			;move down list
GTORG0:	HRRZ	D,(C)			;get ptr to next element in list
	JUMPN	D,GTORG1		;are we at end of list?
GTORG4:	EXCH	C,LIST3			;yes
	PUSHJ	P,GETAVL		;add this story at end of originals list
	HRLZM	X2,(LIST3)
	MOVE	LIST3,C			;restore LIST3
	POPJ	P,
;ADORIG  RETLST

ADORIG:	MOVEI	C,ORIGHD#		;get ptr to head of list of original stories
	JRST	AD0
AD1:	HLRZ	X1,(D)			;get index ptr of this list element

	MOVEI	LIST3,SORDID(SORPTR)	;get ptr to header of main list
	JRST	AD2
AD3:	HLRZ	X,(B)			;get index ptr of this element
	CAMN	X,X1			;is it same story?
	JRST	AD4			;yes.  nothing special to do
	CAMG	X,NEWX			;no.  is X in top part of INDEX?
	JRST	AD5			;yes
	CAML	X,X1			;no (bottom part)
	CAMG	X1,NEWX
	JRST	INSX
	JRST	AD6
AD5:	CAMG	X,X1			;(X in top part)
	CAML	X1,NEWX
	JRST	AD6
INSX:	PUSHJ	P,GETAVL		;insert X1 at this point in main list
	HRLI	X1,(B)			;make new list element point to next one
	MOVSM	X1,(LIST3)
	JRST	AD4
AD6:	MOVE	LIST3,B			;advance down main list
AD2:	HRRZ	B,(LIST3)		;get ptr to next element in main list
	JUMPN	B,AD3			;at end of list?
	JRST	INSX			;yes.  place X1 here

AD4:	MOVE	C,D
AD0:	HRRZ	D,(C)			;get ptr to next list element
	JUMPN	D,AD1			;at end of list?
	SKIPN	A,ORIGHD
	POPJ	P,
;	JRST	RETLST			;return list to free storage

;RETLST returns a list to available list storage.  call is done like:
;;;	SKIPE	A,<address of list header>
;;;	PUSHJ	P,RETLST
;The header of the list is NOT cleared.
RETLST:	MOVE	C,A			;put ptr to first element of ret'd list
	EXCH	C,AVSLST		;	in header for avail list
RET1:	HRRZ	B,(A)			;next element in list
	JUMPE	B,RET2			;at end of list?
	HRRZ	A,(B)			;no.  next element in list
	JUMPN	A,RET1			;at end of list?
	MOVE	A,B			;yes
RET2:	HRRZM	C,(A)			;link up ret'd list with old avail list
	POPJ	P,
;SETUP   NEXT1   NEXT2

SETUP:	HRLM	SORPTR,(P)
	PUSHJ	P,GETCH
	PUSHJ	P,FACTOR
	TLZ	F,OP1FLG+OP2FLG
	HLRZ	A,(P)
	HRRE	LIST1,SORDID(A)
	HLLZS	SORDID(A)
	HRRE	LIST2,SORDID(SORPTR)
	MOVEI	LIST3,SORDID(SORPTR)
	JUMPLE	LIST1,SET1
	TLO	F,OP1FLG
	MOVEM	LIST1,HEAD1
	HLRZ	X1,(LIST1)
	JRST	SET2
SET1:	MOVN	LIST1,LIST1
	HRRZ	X1,LINKS+1(LIST1)
	SETZM	HEAD1
SET2:	JUMPLE	LIST2,SET3
	TLO	F,OP2FLG
	MOVEM	LIST2,HEAD2
	HLRZ	X2,(LIST2)
	POPJ	P,
SET3:	MOVN	LIST2,LIST2
	HRRZ	X2,LINKS+1(LIST2)
	SETZM	HEAD2
	POPJ	P,

NEXT1:	TLNE	F,OP1FLG
	JRST	NEXT11
	HLRZ	LIST1,LINKS(LIST1)
	HRRZ	X1,LINKS+1(LIST1)
	POPJ	P,
NEXT11:	HRRZ	LIST1,(LIST1)
	HLRZ	X1,(LIST1)
	POPJ	P,

NEXT2:	TLNE	F,OP2FLG
	JRST	NEXT21
	HLRZ	LIST2,LINKS(LIST2)
	HRRZ	X2,LINKS+1(LIST2)
	POPJ	P,
NEXT21:	HRRZ	LIST2,(LIST2)
	HLRZ	X2,(LIST2)
	POPJ	P,
;SDIFF

SDIFF:	PUSH	P,SORPTR	;save ptr to first operand of intersection
SDFSET:	PUSHJ	P,SETUP		;label here is used to search stack for this call
	SUB	P,[1,,1]	;pop sorptr off stack
SD0:	JUMPE	LIST1,FINISH
	JUMPE	LIST2,COPY1
	CAME	X1,X2
	JRST	SD4
	PUSHJ	P,NEXT1
	PUSHJ	P,NEXT2
	JRST	SD0
SD4:	CAML	X1,OLDX
	JRST	SDBOTT
	CAMG	X1,X2
	JRST	SD1
SD2:	PUSHJ	P,GETAVL
	HRLM	X1,(LIST3)
	PUSHJ	P,NEXT1
	JRST	SD0
SD1:	CAML	X2,OLDX
	JRST	SD2
SD3:	PUSHJ	P,NEXT2
	JRST	SD0
SDBOTT:	CAML	X2,OLDX
	CAMG	X1,X2
	JRST	SD3
	JRST	SD2
;UNION

UNION:	PUSHJ	P,SETUP
UN0:	JUMPE	LIST1,COPY2
	JUMPE	LIST2,COPY1
	CAME	X1,X2
	JRST	UN4
	PUSHJ	P,GETAVL
	HRLM	X1,(LIST3)
	PUSHJ	P,NEXT1
	PUSHJ	P,NEXT2
	JRST	UN0
UN4:	CAML	X1,OLDX
	JRST	UNBOTT
	CAMG	X1,X2
	JRST	UN1
UN2:	PUSHJ	P,GETAVL
	HRLM	X1,(LIST3)
	PUSHJ	P,NEXT1
	JRST	UN0
UN1:	CAML	X2,OLDX
	JRST	UN2
UN3:	PUSHJ	P,GETAVL
	HRLM	X2,(LIST3)
	PUSHJ	P,NEXT2
	JRST	UN0
UNBOTT:	CAML	X2,OLDX
	CAMG	X1,X2
	JRST	UN3
	JRST	UN2
;INTER

INTER:	PUSH	P,SORPTR	;save ptr to first operand of intersection
INTSET:	PUSHJ	P,SETUP		;label here is used to search stack for this call
	SUB	P,[1,,1]	;pop sorptr off stack
INT0:	JUMPE	LIST1,FINISH
	JUMPE	LIST2,FINISH
	CAME	X1,X2
	JRST	INT4
	PUSHJ	P,GETAVL
	HRLM	X1,(LIST3)
	PUSHJ	P,NEXT1
	PUSHJ	P,NEXT2
	JRST	INT0
INT4:	CAML	X1,OLDX
	JRST	INBOTT
	CAMG	X1,X2
	JRST	INT1
INT2:	PUSHJ	P,NEXT1
	JRST	INT0
INT1:	CAML	X2,OLDX
	JRST	INT2
INT3:	PUSHJ	P,NEXT2
	JRST	INT0
INBOTT:	CAML	X2,OLDX
	CAMG	X1,X2
	JRST	INT3
	JRST	INT2
;COPY1   COPY2   FINISH

COPY1:	JUMPE	LIST1,FINISH
	TLNE	F,OP1FLG
	JRST	COP12
COP11:	PUSHJ	P,GETAVL
	HRLM	X1,(LIST3)
	HLRZ	LIST1,LINKS(LIST1)
	HRRZ	X1,LINKS+1(LIST1)
	JUMPN	LIST1,COP11
	JRST	FINISH
COP12:	PUSHJ	P,GETAVL
	HRLM	X1,(LIST3)
	HRRZ	LIST1,(LIST1)
	HLRZ	X1,(LIST1)
	JUMPN	LIST1,COP12
	JRST	FINISH

COPY2:	JUMPE	LIST2,FINISH
	TLNE	F,OP2FLG
	JRST	COP22
COP21:	PUSHJ	P,GETAVL
	HRLM	X2,(LIST3)
	HLRZ	LIST2,LINKS(LIST2)
	HRRZ	X2,LINKS+1(LIST2)
	JUMPN	LIST2,COP21
	JRST	FINISH
COP22:	PUSHJ	P,GETAVL
	HRLM	X2,(LIST3)
	HRRZ	LIST2,(LIST2)
	HLRZ	X2,(LIST2)
	JUMPN	LIST2,COP22

FINISH:	HLLZS	(LIST3)			;put null ptr on end of resultant list
	SKIPE	A,HEAD1			;is first list null?
	PUSHJ	P,RETLST		;no.  return it to free storage
	SKIPE	A,HEAD2			;is second list null?
	JRST	RETLST			;no.  return it to free storage
	POPJ	P,
;LATEST  SEQNBR
;build up a list of the latest n stories, where n is a number typed in.
LATEST:	PUSHJ	P,INNBR		;read in nbr of stories to be found (CNT)
LAT1:	MOVEI	LIST3,SORDID(SORPTR);set up list ptr to header of list
	JUMPN	CNT,.+2
	MEDERR	(MISSING OR ZERO COUNT AFTER ".")	;	;
	MOVEM	CNT,SAVCNT#
	MOVE	X,NEWX		;get index of NEW area
LAT3:	CAMN	X,OLDX		;check if index has run into OLD
	JRST	LAT4		;it has.  no more stories can be retrieved
	SUBI	X,XSIZE		;get previous index entry
	CAIGE	X,SPECS
	MOVEI	X,XLEN-XSIZE
	PUSHJ	P,GTORIG	;put original for this story onto the list
	SOSLE	SAVCNT		;have enough stories been found?
	JRST	LAT3
SEQ2:LAT4:HLLZS	(LIST3)		;yes.  put null ptr at end of list
	PUSHJ	P,ADORIG	;add to the list any originals referenced
	TLZE	F,NOTIFY	;notification requested?
	OUTSTR	[ASCIZ/NOTIFICATION NOT POSSIBLE FOR EXPRESSIONS CONTAINING "." OR "#" CONSTRUCTS
/]
	JRST	GETCH1
;build up a list of the stories within a given range of sequence numbers
SEQNBR:	PUSHJ	P,INNBR		;read in the seq nbr (CNT)
	MOVEM	CNT,SEQBEG
	CAIN	CHAR,":"	;is this a range of seq nbrs?
	PUSHJ	P,INNBR		;yes.  get seq nbr for end of range
	JUMPN	CNT,SEQ3	;if the end nbr is 0 and the
	SKIPE	SEQBEG		;	beginning nbr is not 0, then
	MOVEI	CNT,-1		;	∞ is used for the end nbr
SEQ3:	MOVEM	CNT,SEQEND
	SUB	CNT,SEQBEG
	MOVEM	CNT,SAVCNT#
	MOVEI	LIST3,SORDID(SORPTR);set up list ptr to header of list
	MOVE	X,NEWX		;get index of NEW area
SEQ1:	CAMN	X,OLDX		;has the index run into OLD already?
	JRST	SEQ2		;yes.  that's all the stories there are
	SUBI	X,XSIZE		;no.  get index of previous story
	CAIGE	X,SPECS
	MOVEI	X,XLEN-XSIZE
	HRRZ	A,INDEX+2(X)	;get seq nbr for this story
	CAMGE	A,SEQBEG
	JRST	SEQ5
	SKIPL	SAVCNT
	CAMG	A,SEQEND
	JRST	SEQ4
	JRST	SEQ1
SEQ5:	JUMPGE	CNT,SEQ1
	CAMG	A,SEQEND
SEQ4:	PUSHJ	P,GTORIG	;put original for this story onto the list
	JRST	SEQ1		;dont care whether story was on list
	JRST	SEQ1		;go look for more stories
;GETSTY  INNBR   RDNBR   PTZERO  PRNTNO  NXTDG   PTREST

GETSTY:	CAIE	CHAR,"*"	;does the user want to reference the oldest story?
	JRST	RDNBR		;no.  read in a story number
	MOVE	CNT,NFOUND	;yes.  get the number of the oldest story
	JRST	GETCH
INNBR:	ILDB	CHAR,LINEBP	;load 1st char of number
RDNBR:	SETZ	CNT,		;CNT will hold the value of the number
RDNBR1:	CAIG	CHAR,"9"	;is present char a digit?
	CAIGE	CHAR,"0"
	JRST	GETCH1		;no.  return
	IMULI	CNT,=10		;yes.  multiply previous sum by =10 and
	ADDI	CNT,-60(CHAR)	;	add in current digit
	ILDB	CHAR,LINEBP	;load the next potential digit
	JRST	RDNBR1

PTZERO:	CAIGE	PART1,=10
	OUTCHR	["0"]		;print a leading zero if number is less than ten
PRNTNO:	MOVE	B,[POINT 7,DIGITS]
	PUSHJ	P,NXTDG
	SETZ	PART1,
	IDPB	PART1,B
	OUTSTR	DIGITS
	POPJ	P,

NXTDG:	IDIVI	PART1,=10
	PUSH	P,PART2
	SKIPE	PART1
	PUSHJ	P,NXTDG
	POP	P,PART1
	ADDI	PART1,60
	IDPB	PART1,B
	POPJ	P,

;type out remaining part of input line following an error
PTREST:	OUTSTR	[ASCIZ/: /]
	JRST	REST2
REST1:	OUTCHR	CHAR
	ILDB	CHAR,LINEBP
REST2:	JUMPN	CHAR,REST1
	OUTSTR	CRLF
	POPJ	P,
;PUTDAT  CLEARU

PUTDAT:	OPEN	16,DSK17
	UBIGERR	124	;	;OPEN FAILED ON DSK
	MOVE	A,PPN
	MOVEM	A,USEF+3
	ENTER	16,USEF		;ENTER new USE.DAT
	JRST	NOUSE
	PUSHJ	P,GETDAT
	JRST	NOUSE
	SETZ	D,
	CALLI	D,27		;RUNTIM
	SUBM	D,LOCDAT+CPUTIM	;calculate and store amount of cpu time used lately
	MOVE	CNT,[2-ULEN,,1]
NXTU:	MOVE	A,LOCDAT(CNT)
	ADDM	A,TOTDAT(CNT)	;add local data to grand totals kept in USE.DAT
	AOBJN	CNT,NXTU
	MOVEI	A,-ULEN
	HRLM	A,UCMD
	OUT	16,UCMD
	JRST	.+2
	JRST	NOOUT		;OUTPUT FAILED
	RELEAS	16,
CLEARU:	SETZM	LOCDAT
	MOVE	A,[XWD LOCDAT,LOCDAT+1]
	BLT	A,LOCDAT+ULEN-1
	MOVEM	D,LOCDAT+CPUTIM	;save total cpu time since login
	POPJ	P,

NOOUT:	SUBM	D,LOCDAT+CPUTIM	;put back earlier total cpu time since login
NOUSE:	RELEAS	16,3
	POPJ	P,
;GETDAT  PTIME

;read in usage data file
GETDAT:	OPEN	15,DSK17
	UBIGERR	130	;	;OPEN FAILED ON DSK
	MOVE	A,PPN
	MOVEM	A,USEF+3
	LOOKUP	15,USEF
	JRST	GETXIT
	HLRE	A,USEF+3		;get size of data file
	CAMGE	A,[-ULEN]		;is it bigger than array?
	MOVEI	A,-ULEN			;yes.  only read in enough to fill array?
	HRLM	A,UCMD			;store amount to read in
	SETZM	TOTDAT
	MOVE	A,[TOTDAT,,TOTDAT+1]
	BLT	A,TOTDAT+ULEN-1
	IN	15,UCMD
	AOS	(P)			;skip return for success
GETXIT:	RELEAS	15,
	POPJ	P,

PTIME:	IDIVI	A,=1000			;convert time to seconds
	IDIVI	A,=60			;convert time to minutes
	MOVE	C,A+1			;save seconds
	IDIVI	A,=60			;convert time to hours
	MOVE	PART1,A
	PUSHJ	P,PTZERO		;print hours
	OUTCHR	[":"]
	MOVE	PART1,A+1
	PUSHJ	P,PTZERO		;print minutes
	OUTCHR	[":"]
	MOVE	PART1,C
	JRST	PTZERO			;print seconds and return
;PRINTU

PRINTU:	PUSHJ	P,GETDAT		;read in usage data file
	POPJ	P,			;couldn't read in file. give up
	SETO	A,
	GETLIN	A			;get tty line number
	HRRZ	A,A
	CAIL	A,27			;is it a DD?
	CAIL	A,120
	JRST	PU1			;nope
	DPYSIZ	0000			;yup.  move pp to top of screen
	MOVEI	A,1
	CALLI	A,31	;SLEEP
	PTWR1W	[0↔14120]		;[BRK]P.  clear screen
	PTWR1W	[0↔10116]		;[ESC]N.  normalize pp
PU1:
	OUTSTR	[ASCIZ \
DATA SINCE \]
	LDB	A,[POINT 11,TOTDAT,23]	;get time data cleared
	IDIVI	A,=60
	MOVE	PART1,A
	PUSHJ	P,PTZERO		;print hour
	MOVE	PART1,A+1
	PUSHJ	P,PTZERO		;print minutes
	OUTCHR	[" "]
	LDB	A,[POINT 12,TOTDAT,35]	;get date data cleared
	IDIVI	A,=31
	MOVEI	PART1,1(A+1)
	PUSHJ	P,PRNTNO		;print day of month
	IDIVI	A,=12
	OUTCHR	["-"]
	OUTSTR	MONTHS(A+1)		;print month
	OUTCHR	["-"]
	MOVEI	PART1,=64(A)
	PUSHJ	P,PRNTNO		;print year
	OUTSTR	CRLFS
	MOVE	C,[4-ULEN,,3]
TOPU:	OUTSTR	@MSGDAT(C)
	MOVE	PART1,TOTDAT(C)
	PUSHJ	P,PRNTNO
	OUTSTR	CRLF
	AOBJN	C,TOPU
	OUTSTR	[ASCIZ/
CPU TIME    (HR:MIN:SEC).........../]
	MOVE	A,TOTDAT+CPUTIM
	PUSHJ	P,PTIME
	OUTSTR	[ASCIZ/
SEARCH TIME (HR:MIN:SEC).........../]
	MOVE	A,TOTDAT+SRCTIM
	PUSHJ	P,PTIME
	OUTSTR	CRLFS
	POPJ	P,
;ZEROUS

ZEROUS:	OUTSTR	[ASCIZ \CLEAR? \]
	INCHRW	A
	CAIE	A,"%"
	POPJ	P,
	INCHRW	A
	CAIE	A,"π"
	POPJ	P,
	OPEN	16,DSK17
	UBIGERR	140	;	;OPEN FAILED ON DSK
	HLLZS	USEF+1
	SETZM	USEF+2
	MOVE	A,PPN
	MOVEM	A,USEF+3
	ENTER	16,USEF
	JRST	[RELEAS 16,
		 OUTSTR	[ASCIZ \ FAILED
\]
		 POPJ	P,]
	CALLI	A,400072		;DSKTIM.  get time/date
	MOVEM	A,TOTDAT
	SETZM	TOTDAT+1
	MOVE	A,[XWD TOTDAT+1,TOTDAT+2]
	BLT	A,TOTDAT+ULEN-1
	MOVEI	A,-ULEN
	HRLM	A,UCMD
	OUT	16,UCMD
	JRST	.+2
	UBIGERR	144	;	;OUT UUO FAILED FOR USE.DAT
	RELEAS	16,
	OUTSTR	[ASCIZ \ DONE\]
	POPJ	P,
;SAVPPN

SAVPPN:	OPEN	14,DSK17
	UBIGERR	150	;	;OPEN FAILED ON DSK
	MOVE	B,PPN
	MOVEM	B,USERSF+3
	LOOKUP	14,USERSF
	JRST	XPPN
	HLRE	A,USERSF+3
	MOVE	B,PPN
	MOVEM	B,USERSF+3
	ENTER	14,USERSF
	JRST	XPPN
	MOVN	A,A
	LDB	B,[POINT 7,A,35]
	ASH	A,-7
	JUMPE	B,WRT
	USETI	14,1(A)
	MOVN	C,B
	HRLM	C,PCMD
	IN	14,PCMD
	JRST	.+2
	JRST	XPPN
WRT:	USETO	14,1(A)
	LDB	A,[POINT 6,USRPPN,23]
	TRCE	A,40
	TRO	A,100			;convert PPN from SIXBIT to ASCII
	DPB	A,[POINT 7,USERS(B),6]
	LDB	A,[POINT 6,USRPPN,29]
	TRCE	A,40
	TRO	A,100
	DPB	A,[POINT 7,USERS(B),13]
	LDB	A,[POINT 6,USRPPN,35]
	TRCE	A,40
	TRO	A,100
	DPB	A,[POINT 7,USERS(B),20]
	MOVEI	A," "			;put a space after the PPN
	DPB	A,[POINT 14,USERS(B),34]
	SETZM	USERS+1(B)
	MOVNI	B,2(B)
	HRLM	B,PCMD
	OUTPUT	14,PCMD
	TRO	F,PPNDUN
XPPN:	RELEAS	14,
	POPJ	P,
;READIT

READIT:	HRRZ	DISPL,INDEX+1(X)	;get the story's displ from beginning of rec
	MOVE	SIZE,X			;calculate the index of the next story
	ADDI	SIZE,XSIZE
	CAIL	SIZE,XLEN
	MOVEI	SIZE,SPECS
	MOVN	SIZE,INDEX+1(SIZE)	;subtract the rec nbr and displ of next story from zero
	ADD	SIZE,INDEX+1(X)		;	and add in the rec nbr and displ of the
	JUMPL	SIZE,ONWARD		;	current story. this gets negated size of current story
DOWN:	MOVN	SIZE,INDEX+3		;the current story is the bottom one in NEWS
	JUMPE	SIZE,CPOPJ		;zero means this is a fake story. NEWS has never wrapped around
	ADD	SIZE,INDEX+1(X)		;recalculate its size using ptr to bottom of file
ONWARD:	ASH	SIZE,-13		;shift out the =11 low order zero bits of the size
	ASH	DISPL,-13		;shift out the =11 low order zero bits of the displ
	MOVNM	SIZE,TOTSIZ#		;save the size of the story (positive size)
	SUB	SIZE,DISPL		;add in the displ to get the amt that has to be read in
	HRLM	SIZE,CMD		;store this amt (negated) in the input command
AGAIN1:	OPEN	4,DSK17			;LOOKUP the NEWS file for reading in the story
	UBIGERR	154	;	;OPEN FAILED ON DSK
	MOVE	A,PPN
	MOVEM	A,NEWSF+3		;store ppn of [ap,sys] in lookup block
	LOOKUP	4,NEWSF
	JRST	[RELEASE 4,		;NEWS file in use. wait and try the LOOKUP again
		 MOVEI	A,1
		 CALL	A,[SIXBIT /SLEEP/]
		 JRST	AGAIN1]
	HLRZ	A,INDEX+1(X)		;get the record nbr for this story
	USETI	4,(A)			;select that record for input from NEWS
	IN	4,CMD			;read in the story in STORY area
	JRST	.+2
	UBIGERR	160	;	;IN UUO FAILED TO READ IN NEWS STORY
	RELEAS	4,

	ADDI	DISPL,STORY		;make DISPL into ptr to first word of the story
	LDB	B,[POINT 7,(DISPL),6]	;CALCULATE APPARENT SEQ NBR OF STORY READ
	SUBI	B,60			;	IN FROM NEWS
	IMULI	B,=10
	LDB	C,[POINT 7,(DISPL),13]
	ADDI	B,-60(C)
	IMULI	B,=10
	LDB	C,[POINT 7,(DISPL),20]
	ADDI	B,-60(C)
	HRRZ	A,INDEX+2(X)	;GET SEQ NBR FROM INDEX FOR THIS STORY
	CAMN	A,B		;CHECK CALCULATED SEQ NBR AGAINST THAT IN INDEX
CPOPJ1:	AOS	(P)
CPOPJ:	POPJ	P,
;SEARCH

CH←←0
BP←←1
J←←2
TEST←←3

SAVACS:	BLOCK	20		;block for storing AC during search in ACs

SEARCH:	PUSHJ	P,READIT
	JRST	SRCXIT		;story has disappeared, so keyword not found
	AOS	NBRSRC		;count number of stories searched
	SETZM	FNDIT#
	MOVEM	17,SAVACS+17
	MOVE	17,[XWD 0,SAVACS]
	BLT	17,SAVACS+16	;save the ACs
	MOVE	BP,DISPL
	HRLI	BP,440700	;set up byte pointer into story
	MOVE	17,[XWD CODE,4]
	BLT	17,17		;move loop code into ACs
	JRST	NX		;jump into loop

CODE:
	PHASE	4		;this code will go into ACs 4 to 17
NX←←.	ILDB	CH,BP
	CAIE	CH,
	CAIN	CH,
	JRST	GOT1
NX1←←.	JUMPN	CH,NX
	JRST	EOS		;found end of story without finding keyword
NX2←←.	ILDB	CH,BP		;CH holds char from story
	ANDI	CH,137		;make upper case
	ILDB	TEST,TESTB#	;TEST holds char from keyword
	CAIN	CH,(TEST)
NX3←←.	SOJGE	J,NX2
	JRST	GOTALL
	DEPHASE

GOT1:	SETZM	END#
	MOVE	J,MINBP
	MOVEM	J,TESTB
	MOVE	J,NEND
	JRST	NX3

GOTALL:	JUMPGE	J,NOHIT
	SKIPE	END
	JRST	HIT
	SETOM	END
	MOVEM	BP,SAVBP#
	ILDB	CH,BP		;get char after last char in possible keyword
	CAIL	CH,"A"		;is it a word delimiter?
	JRST	NOHIT		;no.  it's a letter
	CAIGE	CH,"0"
	JRST	.+3
	CAIG	CH,"9"
	JRST	NOHIT		;no.  it's a digit
	SUB	BP,WDIF
	SKIPA	J,BDIF
	IBP	BP
	SOJGE	J,.-1
	LDB	CH,BP		;get char before first char in possible keyword
	CAIL	CH,"A"		;is it a word delimiter?
	JRST	NOHIT		;no.  it's a letter
	CAIGE	CH,"0"
	JRST	.+3
	CAIG	CH,"9"
	JRST	NOHIT		;no.  it's a digit
	MOVE	J,FSTBP
	MOVEM	J,TESTB
	MOVE	J,NBEG
	JRST	NX3

NOHIT:	SKIPE	END
	JRST	NOHIT1
	LDB	CH,BP
	JRST	NX1
NOHIT1:	MOVE	BP,SAVBP
	JRST	NX

HIT:	SETOM	FNDIT
EOS:	MOVE	17,[XWD SAVACS,0]
	BLT	17,17
	SKIPN	FNDIT
	JRST	SRCXIT
	PUSHJ	P,GTORIG	;found keyword in story, so link up original for
	OUTCHR	["*"]		;	this story
	MOVE	D,SAVACS+D	;GTORIG wipes out D

SRCXIT:	SKIPE	INTFG
	JRST	SRCHX1
	INCHSL	GARBLE#		;if user has typed a line, he wants to end search
	POPJ	P,		;has not typed a line.  continue
	CLRBFI			;clear the interrupting char(s) from tty buffer
SRCHX1:	OUTSTR	[ASCIZ/ Search terminated manually after /]
	EXCH	X,NBRSRC	;print number of stories searched
	PUSHJ	P,PRNTNO
	MOVE	X,NBRSRC	;restore X
	OUTSTR	[ASCIZ/ stories./]
	AOS	(P)		;skip return from SEARCH when interrupted
	POPJ	P,
;LOOK
F0:	DEC	132,138,95,31,35,40,35,63,38,64
FA:	DEC	1814,346,773,871,2597,456,402,760,1761,43,116,818,644
	DEC	1746,1753,551,10,1459,1347,1897,548,294,292,88,313,17
LOOK0:	OUTSTR	CRLF
LOOK:	AOS	USCH			;bump counter of number of searches
	SETZM	INTFG
	OUTSTR	[ASCIZ/Searching.../]
	SETZ	A,
	CALLI	A,27			;RUNTIM
	MOVEM	A,STTIM#		;save the cpu time to calculate search time
	MOVEI	A,-1
	MOVEM	A,MINFRQ#		;initialize min freq to large nbr

	MOVE	A,FSTBP#
	SETO	CNT,			;count nbr of chars - 1
LOOK3:	ILDB	C,A			;find least common char and convert
	JUMPE	C,LOOK4			;	all letters to upper case
	ANDI	C,137			;	by turning off 40 bit
	DPB	C,A
	CAIGE	C,"0"-40
	AOJA	CNT,LOOK3		;neither a digit or a letter (must be space)
	MOVE	D,FA-101(C)		;get freq assuming letter
	TRNN	C,100
	MOVE	D,F0-20(C)		;get freq for digit
	CAML	D,MINFRQ		;less freq than any so far?
	AOJA	CNT,LOOK3		;no
	ADDI	CNT,1
	MOVEM	D,MINFRQ#		;yes.  save freq,
	MOVEM	A,MINBP#		;	byte ptr,
	MOVEM	CNT,NBEG#		;	nbr of chars before this,
	MOVNM	CNT,NEND#		;  and  negative of nbr of char before.
	JRST	LOOK3

LOOK4:	IDPB	C,A
	TLNE	A,760000
	JRST	.-2
	TLZ	A,-1
	SUBI	A,POLISH
	MOVE	C,POLPTR
	SUB	A,C
	HRRZM	A,POLISH(C)
	HRLM	A,POLISH(C)
	ADDB	A,POLPTR
	CAIL	A,POLLEN
	HALT	.	;	;

	ADDM	CNT,NEND#
	LDB	C,MINBP
	ORI	C,40
	HRRM	C,CODE+1
	ANDI	C,137
	HRRM	C,CODE+2
	ADDI	CNT,2
	IDIVI	CNT,5
	JUMPE	CNT+1,LOOK5
	ADDI	CNT,1
	MOVN	CNT+1,CNT+1
	ADDI	CNT+1,5
LOOK5:	MOVEM	CNT,WDIF#
	MOVEM	CNT+1,BDIF#
	SETZM	NBRSRC#			;zero out the number of stories searched
	MOVEI	LIST3,SORDID(SORPTR)
	MOVE	A,P
	JRST	LOOK7
LOOK6:	HRRZ	B,(A)
	CAIE	B,SDFSET+1		;is this the second part of a set diff?
	CAIN	B,INTSET+1		;no.  second part of an intersection?
	JRST	GOTINT			;yes to one of these
	SUB	A,[1,,1]
LOOK7:	CAME	A,[IOWD PDLEN,PDLIST]	;have we searched entire stack?
	JRST	LOOK6			;nope

	MOVE	X,NEWX
LOOK1:	CAMN	X,OLDX			;have we searched the oldest story yet?
	JRST	LOOK2			;yes.  finish up
	SUBI	X,XSIZE			;no.  get index of next older story
	CAIGE	X,SPECS
	MOVEI	X,XLEN-XSIZE
	PUSHJ	P,SEARCH		;search the story for the keyword
	JRST	LOOK1
LOOK2:	HLLZS	(LIST3)			;put null ptr on end of list
	PUSHJ	P,ADORIG		;add to list any originals referenced
	OUTSTR	CRLF
	SETZ	X,
	CALLI	X,27
	SUB	X,STTIM			;calculate search time and print it
	ADDM	X,LOCDAT+SRCTIM		;add to previous search time
	OUTSTR	[ASCIZ/Search time in msec: /]
	PUSHJ	P,PRNTNO
	OUTSTR	CRLF
	JRST	GETCH1

GOTINT:	MOVE	D,-1(A)		;get ptr to story list for first part of expr
	HRRE	D,SORDID(D)		;get ptr to first story in list
	JUMPGE	D,GOTIN1		;ptr < 0 means ptr into LINKS
	MOVN	D,D
	JRST	.+2
GOTIN2:	HLRZ	D,LINKS(D)		;get ptr to next element in list
	JUMPE	D,LOOK2			;zero ptr means end of list
	HRRZ	X,LINKS+1(D)		;get index ptr for this story in list
	PUSHJ	P,SEARCH
	JRST	GOTIN2
	JRST	LOOK2
GOTIN3:	HRRZ	D,(D)			;get ptr to next element in list
GOTIN1:	JUMPE	D,LOOK2
	HLRZ	X,(D)			;get index ptr for this story
	PUSHJ	P,SEARCH
	JRST	GOTIN3
	JRST	LOOK2			;search was interrupted
;SHRINK  UUCODE

SHRINK:	HLRZ	A,JOBSA
	MOVEM	A,JOBFF
	CALLI	A,11		;CORE UUO to release extra core accumulated
	UBIGERR	404	;	;CORE UUO FAILED
	POPJ	P,

UUCODE:	0
	HLRZ	A,40		;get type of error
	ANDI	A,777000	;zero out AC field
;	OUTCHR	["?"]
	CAIN	A,(<UBIGERR>)	;is it a super horrendous error?
	JRST	BADERR
	OUTSTR	@40
	LDB	B,[POINT 4,40,12]; pick up AC field of error UUO
	JUMPE	B,.+2
	CLRBFI			;clear input buffer if AC field is non-zero
	TRZ	F,AUTOCN
	CAIN	A,(<UERR3>)
	JRST	RESET
	PUSHJ	P,PTREST
	CAIN	A,(<UERR2>)
	JRST	RSTART
	CAIN	A,(<UERR1>)
	JRST	APE1
BADERR:	OUTSTR	[ASCIZ/

SUPER HORRENDOUS ERROR #/]
	HRRZ	PART1,40	;get error number
	PUSHJ	P,PRNTNO
	CALLI	0
	CALLI	12
;TELLKY  TELLSL  TELLSC

TELLKY:	OUTSTR	INFO1
	PUSHJ	P,READ
	PUSHJ	P,GETCH
	CAIN	CHAR,"?"
	OUTSTR	INFO2
	JRST	APE1

TELLSL: OUTSTR	INFO3
	PUSHJ	P,READ
	PUSHJ	P,GETCH
	CAIN	CHAR,"?"
	OUTSTR	INFO4
	JRST	ASKER1

TELLSC:	OUTSTR	INFO5
	TRZ	F,AUTOSC
	JRST	ASKSRC

INFO1:	ASCIZ	%
DETAILED INFORMATION ON THIS PROGRAM IS IN THE FILE: APE.ME[UP,DOC]

   WAR    represents all stories mentioning WAR.
WAR*PEACE represents all stories mentioning both WAR and PEACE.
WAR+PEACE represents all stories mentioning either WAR or PEACE.
WAR-PEACE represents all stories mentioning WAR but not PEACE.

   .n	  (n an unsigned integer) represents the latest n stories.
   #n	  represents all stories with AP sequence number n.
   #n:m	  represents all stories with AP numbers from n to m.
@<filenm> means read expressions from the command file <filenm>.
@!<filenm>means automatically read from the command file <filenm>.
   @      means read another expression from the command file
          (opens the file APE.CMD if no command file open).
   @!     means automatically read expressions from the command file
          (opens the file APE.CMD if no command file open).

NOW type ? and RETURN to get MORE HELP, else type just RETURN.%

comment %
 $<expr>  requests notification when a story comes in matching the
          keyword expression <expr>.
   $      means type out all notification requests and then allow
	  deleting any or all of them.%

INFO2:	ASCIZ	%
Each keyword represents a group of stories, namely all the stories
it occurs in.  A keyword expression consists of either a single
keyword or an expression built from keywords and the operators
* (for INTERSECTION), + (for UNION), and - (for SET DIFFERENCE).
These operators have their usual precedences (* evaluated first).
Note that + and - are BINARY operators only.  Parentheses can be
used freely in keyword expressions.

The special forms ".n" (latest n stories), "#n" (stories numbered n),
and "#n:m" (stories numbered from n to m) can appear anywhere in
place of a keyword.

For a list of the keywords, read the file WORDS.SRT[AP,SYS].  To have
your own special keywords added to the list, SEND a note to ME.%

INFO3:	ASCIZ	%
Syntax for the selection line is as follows, where [...] denotes
an optional quantity and ...|... denotes exclusive alternatives:
(The order is irrelevant except that any filename must come first.)

    [<filenm>[/Q|/X]←] [<story selection>] [S] [K] [W] [C|F|L|D]

<filenm> means save stories in given file (no extension or PPN allowed).
/Q means replace file if it already exists.
/X means extend file if it already exists.

The syntax for <story selection> is:
	[ N | [=]<nbr>[:<nbr>]  ]
where <nbr> is a positive or negative integer (k represents the k newest
stories and -k represents the k oldest stories) and
= means reverse the order of the stories and
N means select None of the stories.

S means Spool the selected stories (not allowed with F or L options).
K means Kill automatic reading from command file.
W means type out the keyWords each story is categorized by.

C means allow Choosing which stories get typed out completely.
F means type out only the First few lines of each story.
L means type out only the Last few lines of each story.
D means Dont type out the stories at all (useful if filing or spooling).

NOW type ? and RETURN to get MORE HELP, else type just RETURN.%

INFO4:	ASCIZ	%
If you use the Choose feature, the first few lines of each story will
be typed out and then you will be expected to indicate whether you want
to read the rest of the story.  If you do not want to read the rest of
the story, type just carriage return.  To read the rest of the story,
type altmode, linefeed, or any character (except "I") followed by
carriage return.  If you don't want to read any more of the stories,
type "I" and carriage return.  You will be allowed to quit reading a
story at the beginning of each part (take, correction, etc.).

In the <story selection>:
  To select the k newest stories in normal order, type the number "k".
  To select the k oldest stories in normal order, type the number "-k".
  To select the jth story thru the kth story, type "j:k".  Note that
    in this construction, "1" represents the newest story, larger
    numbers represent older stories, "*" represents the oldest story,
    and finally, "-k" represents the kth oldest story.  Thus, "-1" is
    equivalent to "*"; both represent the oldest story.  The stories
    will come out in the order you specify: story j first, story k
    last.

For even more help, read the file APE.ME[UP,DOC].

%

INFO5:	ASCIZ	%

A search of the news file is available for words that are not in the
keyword dictionary.  Multiple word keyword searches are also possible
but occurrences that are split between lines will not be found.  It
takes about 8 to 10 secs of computer time PER unknown keyword to
search the whole news file.  However, if an unknown keyword occurs
as the SECOND part of an intersection or difference (eg, NIXON * JJJJ
or NIXON - JJJJ), then only the necessary stories are searched (in
the examples, only those stories containing NIXON).

During a search for a keyword, each time a story is found that
contains the keyword, an asterisk (*) is typed out.  You may inter-
rupt the search at any time by typing [ESC] I or carriage return.
Any stories found up to that point will be available.  Stories are
searched in the order of newest to oldest.  To get a search, answer
the question below with a Y and carriage return; type ? and return
to get this summary and just carriage return to avoid a search.

%
;NOTE

NOTE:	PUSHJ	P,NOTPPN		;is this guy allowed to make notif requests?
	POPJ	P,			;NO!
	SETOM	RQBUF			;first two words of a request are -1
	SETOM	RQBUF+1
	CALLI	A,14			;DATE
	ADDI	A,2*=31			;let request live two months
	HRL	A,B			;NOTPPN left programmer name in B.
	MOVSM	A,RQBUF+3		;save date,,programmer name in request
	AOS	A,POLPTR		;get number of words for polish expression
	HRL	A,A			;and save it for request
	MOVEM	A,RQBUF+2		;also prepare to save total length of request
	MOVEI	B,7			; including 7 special words
	ADDM	B,RQBUF+2
	MOVE	B,[POLISH,,RQBUF+4]	;blt polish expression into output buffer
	BLT	B,RQBUF+3(A)
	SETZM	RQBUF+4(A)		;first word after polish is a zero

	MOVE	B,[POINT 7,TMPBUF]
	ILDB	C,B
	CAIE	C,"$"			;replace the $ with a (
	JRST	.-2
	MOVEI	C,"("
	DPB	C,B
	MOVE	B,LINEBP	;(LINEBP now points at zero byte after keyw expr)
	MOVEI	C,")"			;add a ) after keyw expr
	DPB	C,B
	SETZ	C,
	IDPB	C,B			;deposit zero bytes until end of word
	TLNE	B,760000
	JRST	.-2

	MOVEI	B,1-TMPBUF(B)		;compute length of keyw expr
	ADDB	B,RQBUF+2		;and include in total length of request
	ADDI	A,RQBUF+5		;prepare to blt keyword expression into
	HRLI	A,TMPBUF		;	the request output buffer
	BLT	A,RQBUF-3(B)
	MOVEI	A,-1
	MOVEM	A,RQBUF-2(B)		;next to last word of request is 0,,-1
	SETZM	A,RQBUF-1(B)		;last word of request is 0
	MOVN	B,B
	HRLM	B,NCMD			;put length of request in output command
LOCK:	MOVEI	A,10			;number of times we will try to interlock
	MOVEM	A,TIMER#		;	the notification data file(s)
LOCK1:	OPEN	10,DSK17
	UBIGERR	800	;	;
	MOVSI	A,'TMP'			;NOTIF.TMP is ENTERed to set the lock
	MOVEM	A,NOTIFF+1
	MOVE	A,PPN
	MOVEM	A,NOTIFF+3
	ENTER	10,NOTIFF
	JRST	LOKOUT			;lock already was set by someone else
NOTE2:	OPEN	11,DSK17		;it's all ours!
	UBIGERR	804	;	;
	MOVSI	A,'ADD'			;request goes into NOTIF.ADD
	MOVEM	A,NOTIFF+1
	MOVE	A,PPN
	MOVEM	A,NOTIFF+3
	LOOKUP	11,NOTIFF		;see if NOTIF.ADD already exists
	JRST	NOLOOK
NOTE3:	MOVE	A,PPN
	MOVEM	A,NOTIFF+3
	ENTER	11,NOTIFF
	JRST	NOENTR
	UGETF	11,B		;extend NOTIF.ADD if in RA mode (if LOOKUP succeeded)
	OUT	11,NCMD			;write out request onto file
	RELEAS	11,			;close request file
	RELEAS	10,3			;CLEAR LOCK!
	AOS	UNOTIF
	OUTSTR	[ASCIZ/Notification request accepted.
/]
	POPJ	P,

LOKOUT:	MOVEI	A,1			;ENTER failed. lock already set
	CALLI	A,31		;SLEEP
	SOSL	TIMER#
	JRST	LOCK1
	OUTSTR	[ASCIZ/Sorry -- Notification data file in use.  Type Y to try again./]
	PUSHJ	P,READY
	JRST	LOCK		;"Y"
	JRST	.-3		;"?"
	OUTSTR	[ASCIZ/Notification request rejected.
/]				;any other char
	RELEAS	10,3
	POPJ	P,

NOLOOK:	HRRZ	B,NOTIFF+1		;LOOKUP failed.
	JUMPE	B,NOTE3			;is it because the file does not exist?
	CAIE	B,3			;NO!!!!
	UBIGERR	810	;	;
	UBIGERR	814	;	;

NOENTR:	HRRZ	B,NOTIFF+1		;ENTER failed on NOTIF.ADD
	CAIE	B,3			;is it because the file is busy?
	UBIGERR	820	;	;NO!!!
	RELEAS	11,			;yes.  make it not quite so busy
	MOVEI	A,1
	CALLI	A,31		;SLEEP
	SOSL	TIMER
	JRST	NOTE2			;try the ENTER again
	RELEAS	10,3			;timed out.  give up.  UNLOCK!!
	OUTSTR	[ASCIZ/LOCKED OUT OF NOTIFICATION DATA FILE!
/]
	POPJ	P,

NOTPPN:	HRRZ	B,USRPPN		;see if this guy is allowed to make requests
	CAIE	B,'GUE'			;too many different GUEs
	CAIN	B,'SYS'			;same for SYSs
	JRST	NOTNOT
	CAIE	B,'FOO'
	CAIN	B,'100'
	JRST	NOTNOT
	AOS	(P)			;skip return on guy ok
	POPJ	P,
NOTNOT:	MOVE	A,[POINT 6,B,17]
	OUTSTR	[ASCIZ/Sorry -- '/]
NOTNT2:	ILDB	C,A
	ADDI	C,40
	OUTCHR	C			;type out his programmer name
	TLNE	A,770000
	JRST	NOTNT2
	OUTSTR	[ASCIZ/' cannot make notification requests.
/]
	POPJ	P,
;NOTEDP

;This routine should do a JRST RSTART when finished

NOTEDP:	AOS	UNDSPY

	JRST	RSTART

	INIT	10,10
	SIXBIT	/DSK/
	NBUF
	UBIGERR	...
	SETZM	NOTIFF+1	;start with main file: NOTIF
	MOVE	A,PPN
	MOVEM	A,NOTIFF+3
	LOOKUP	10,NOTIFF
	JRST	NTCHG		;if file doesn't exist, go on to next file
NXMAIN:	PUSHJ	P,GNTF		;pick up first word of rq: -1
	AOJN	A,NTCHG		;if the first word is not -1, assume eof
	PUSHJ	P,GNTF		;pick up serial number of rq
	MOVEM	A,SERIAL#	; and save it
	PUSHJ	P,GNTF		;pick up length word: P,,L
	HRRZ	B,A		; and save the length L of the remainder of rq
	CAIL	B,200		;make sure length is reasonable
	UBIGERR	...
	PUSHJ	P,GNTF		;pick up DATE,,PN
	MOVE	D,USRPPN
	CAME	D,PPN
	CAIN	D,(A)
	PUSHJ	P,SHMAIN	;SHOW THIS REQUEST TO THIS GUY
	PUSHJ	P,GNTF
	SOJG	B,.-1		;SKIP TO 0 AT END OF REQUEST
	JUMPN	A,NXMAIN
NTCHG:	INIT	10,10
	SIXBIT	/DSK/
	NBUF
	UBIGERR	...
	MOVSI	A,'CHG'
	MOVEM	A,NOTIFF+1
	MOVE	A,PPN
	MOVEM	A,NOTIFF+3
	LOOKUP	10,NOTIFF
	JRST	NTADD
	OUTSTR	[ASCIZ\
There are a few new requests that I can't access right now.
\]
NTADD:	OPEN	10,NT10
	UBIGERR	...















SHMAIN:	PUSHJ	P,SHOWRQ
	POPJ	P,
	SETOM	RQBUF
	MOVE	A,SERIAL#
	HRROM	A,RQBUF+1
	MOVEI	A,2
	MOVEM	A,RQBUF+2
	SETZM	RQBUF+3
	MOVEI	A,-1
	MOVEM	A,RQBUF+4
	SETZM	RQBUF+5
	MOVEI	A,-6
	HRLM	A,NCMD
	JRST	LOCK		;B MUST be zero at POPJ in LOCK





SHOWRQ:	MOVSM	A,TOTDAT
	MOVE	B,[IOWD 200,TMPBUF];put asciz expression into TMPBUF for outstr'ing
	PUSHJ	P,GNTF
	JUMPN	A,.-1		;skip to zero word following polish expr
	PUSHJ	P,GNTF
	PUSH	B,A
	TLNE	A,-1		;end of asciz string?
	JRST	.-3		;no.  get next word
	SETZ	B,		;yes
	OUTSTR	TMPBUF
	OUTSTR	[ASCIZ \ expires \]
	PUSHJ	P,PDATE
	OUTSTR	[ASCIZ\.
Do you wish to delete this request?\]
	PUSHJ	P,READY		;read answer
	AOSA	(P)		;"Y"--take skip return
	JRST	.-3		;"?"--try again
	POPJ	P,		;any thing else--no--direct return


comment ⊗ a sample type-out:

(NIXON*WAR) expires 4 Mar 73.
Do you wish to delete this request?				end of comment ⊗


GNTF:	SOSG	NBUF+2
GNTF1:	IN	10,
	JRST	[ILDB A,NBUF+1
		POPJ P,]
	SETZ	A,
	POPJ	P,
;TYKEYS

TYKEYS:	AOS	UKEYS
	MOVE	D,[POINT 7,STORY]
	HLRZ	A,INDEX(X)
	JUMPE	A,[OUTSTR [ASCIZ/No Keywords
/]
		   JRST FINKEY]
TYKE1:	MOVE	B,A
	HRRE	B,LINKS(B)
	JUMPG	B,.-1
	MOVN	B,B
	PUSHJ	P,GETFAT
	MOVEI	C,CR
	IDPB	C,D
	MOVEI	C,LF
	IDPB	C,D
	HLRZ	A,LINKS+1(A)
	JUMPN	A,TYKE1
	SETZ	C,
	IDPB	C,D
	OUTSTR	STORY
FINKEY:	TLNN	F,DONT
	OUTSTR	[ASCIZ/- - - - - - - - - -/]
	OUTSTR	CRLF
	POPJ	P,

GETFAT:	HLLZ	C,DICT(B)
	HLLM	C,(P)
GETFA4:	HLRZ	C,DICT+2(B)
	CAML	C,DICLEN
	JRST	GETFA2
	HRRZ	SIZE,DICT+2(C)
	CAME	B,SIZE
	JRST	GETFA3
	MOVE	B,C
	JRST	GETFA4
GETFA3:	HLRZ	SIZE,DICT+1(C)
	CAME	B,SIZE
	JRST	GETFA2
	MOVE	B,C
	PUSHJ	P,GETFAT
GETFA2:	HLRZ	B,(P)
	ADD	B,[440700,,WORDS]
GETFA5:	ILDB	C,B
	CAIN	C,"@"
	JRST	GETFA6
	IDPB	C,D
	JRST	GETFA5
GETFA6:	MOVEI	C," "
	IDPB	C,D
	POPJ	P,
;READFL  RFAUTO  RFCON

TVLEAD:	ASCIZ	/COMMENT ⊗   VALID /]
CFILE:	BLOCK	4
SCFILE:	SIXBIT	/APE/
	SIXBIT	/CMD/
	BLOCK	2
CBUF:	BLOCK	3

READFL:	PUSHJ	P,GETCH
	TRZ	F,AUTOCN
	CAIE	CHAR,"!"
	JRST	RF00
	TRO	F,AUTOCN
	PUSHJ	P,GETCH
RF00:	JUMPN	CHAR,OPENFL		;is there a file name?
	TRNE	F,INFILE		;no.  is there an old file open?
	JRST	RFAUTO			;yes
	TRZ	F,CON
	INIT	12,
	SIXBIT	/DSK/
	CBUF
	UBIGERR	374	;	;CANT INIT THE DSK
	SETZM	SCFILE+3		;read standard command file from user's area
	LOOKUP	12,SCFILE
	JRST	RFERR5
	OUTSTR	[ASCIZ/[OPENING APE.CMD]/]
	JRST	RF11

RF01:	PUSHJ	P,RF5			;read until semicolon
	POPJ	P,			;some error
	TRNN	F,INFILE		;hit eof yet?
	POPJ	P,			;yes
RFAUTO:	TRNE	F,CON			;no.  did last expr end with a comma?
	JRST	RF01			;yes
	JRST	RFCON			;no.  get next expr
	
OPENFL:	SETZM	CFILE			;read in new file name and
	SETZM	CFILE+1			;	LOOKUP the new file
	SETZM	CFILE+3
	MOVE	B,[POINT 6,CFILE]	;byte ptr to deposit file name in LOOKUP bk
	MOVEI	C,6			;max length of file name
	PUSHJ	P,RFNAM1		;read in file name
	JRST	RF1			;CR found
	JRST	RFEXT			;"."
	JRST	RFPPN			;"["
	JRST	RFERR2			;","
RFEXT:	MOVE	B,[POINT 6,CFILE+1]	;byte ptr to deposit file name ext
	MOVEI	C,3			;max length of ext
	PUSHJ	P,RFNAME		;read in file name ext
	JRST	RF1			;CR found
	JRST	RFERR2			;"."
	JRST	RFPPN			;"["
	JRST	RFERR2			;","
RFPPN:	MOVE	B,[POINT 6,D]		;byte ptr to deposit project code
	MOVEI	C,3			;max length of project
	PUSHJ	P,RFNAME		;read in project code
	JRST	RFERR2			;CR found
	JRST	RFERR2			;"."
	JRST	RFERR2			;"["
	JRST	.+2
	LSH	D,-6
	SOJGE	C,.-1
	EXCH	D,CFILE+3		;store project and clear D
	MOVE	B,[POINT 6,D,17]	;byte ptr to deposit programmer name
	MOVEI	C,3			;max length of programmer name
	PUSHJ	P,RFNAME		;read in programmer name
	JRST	RF0			;CR found (or "]")
	JRST	RFERR2			;"."
	JRST	RFERR2			;"["
	JRST	RFERR2			;","
RF0:	JRST	.+2
	LSH	D,-6
	SOJGE	C,.-1
	HRRM	D,CFILE+3		;store programmer name
RF1:	TRZ	INFILE!CON
	INIT	12,0
	SIXBIT	/DSK/
	CBUF
	UBIGERR	400	;	;INIT FAILED ON DSK
	SKIPN	CFILE			;zero file name means use APE.CMD
	SKIPE	CFILE+1			;must also have zero extension
	JRST	RF12
	MOVSI	A,'APE'
	MOVEM	A,CFILE
	MOVSI	A,'CMD'
	MOVEM	A,CFILE+1
RF12:	LOOKUP	12,CFILE
	JRST	RFERR3
RF11:	IN	12,
	JRST	.+2
	JRST	RFERR4
	AOS	UATFL
	MOVE	C,[POINT 7,TVLEAD]	;see if the file is in TV format
	MOVE	D,CBUF+1
RF2:	ILDB	A,C
	JUMPE	A,RFTV
	ILDB	B,D			;look at first few chars of file
	CAMN	A,B
	JRST	RF2
	AOS	CBUF+2
	JRST	RFCON		;not a TV file
RFTV:	IN	12,		;find first record after TV directory page
	JRST	.+2
	JRST	RFERR4
	ILDB	CHAR,CBUF+1
	CAIE	CHAR,FF
	JRST	RFTV
RFCON:	OUTCHR	["@"]
	TROA	F,TYPEFL
RF5:	TRZ	F,TYPEFL
	TRO	F,INFILE+AUTOSC
	MOVE	B,[POINT 7,TMPBUF]
	MOVEM	B,LINEBP
RF3:	SOSG	CBUF+2		;buffer used up?
	IN	12,		;yes.  get another
	JRST	RF4
	RELEAS	12,		;eof (assume so anyway)
	PUSHJ	P,SHRINK
	TRZ	F,INFILE!AUTOCN!CON
	JRST	ENDFIL
RF4:	ILDB	CHAR,CBUF+1	;get char from buffer
	MOVE	A,@CBUF+1	;get whole word to test for SOS line number
	TRNE	A,1			;is this an SOS line number?
	JRST	[MOVNI	A,6		;yes.  advance byte pointer and byte
		ADDM	A,CBUF+2	;	count to first char after the
		AOS	CBUF+1		;	tab that follows line number
		ILDB	CHAR,CBUF+1
		JRST	.+1]
	JUMPE	CHAR,RF3		;ignore nulls,
	CAIE	CHAR,CR			;carriage returns,
	CAIN	CHAR,LF			;line feeds,
	JRST	RF3
	CAIN	CHAR,FF			;and form feeds.
	JRST	RF3
	CAIN	CHAR,","		;break on comma
	JRST	CONXPR
	CAIN	CHAR,";"		;	or semicolon.
	JRST	ENDXPR
	IDPB	CHAR,B			;accept any other characters
	JRST	RF3			;get next char from file
CONXPR:	TROA	F,CON			;note that command line continues (comma)
ENDXPR:	TRZ	F,CON			;note that command line ended (semicolon)
ENDFIL:	SETZ	CHAR,
	IDPB	CHAR,B			;place null byte at end of line
	TRNE	F,TYPEFL
	OUTSTR	TMPBUF			;type out the line from the file
	TRNN	F,INFILE		;have we hit eof?
	OUTSTR	[ASCIZ/[EOF]/]		;yes.  tell the poor guy
	TRNE	F,TYPEFL
	OUTSTR	CRLF
	MOVEI	A,CR
	MOVEM	A,BRCHAR		;pretend command line ended with CR
	AOS	(P)			;success return
	POPJ	P,			;done at last!
;RFERR1-5        RFNAME

RFERR1:	SUB	P,[1,,1]
RFERR2:	OUTSTR	[ASCIZ/ILLEGAL FILE SPECIFICATION/]
	JRST	PTREST
RFERR3:	OUTSTR	[ASCIZ/CANT FIND COMMAND FILE
/]
	POPJ	P,
RFERR4:	OUTSTR	[ASCIZ/COMMAND FILE INPUT ERROR
/]
	POPJ	P,
RFERR5:	OUTSTR	[ASCIZ/NO COMMAND FILE OPEN
CANT FIND APE.CMD
/]
	POPJ	P,

RFNAME:	PUSHJ	P,GETCH
RFNAM1:	JUMPE	CHAR,CPOPJ		;end of file name specification?
	CAIN	CHAR,"."		;no.  beginning of extension?
	JRST	CPOPJ1			;yes.  skip return
	CAIN	CHAR,"["		;no.  beginning of ppn?
	JRST	CPOPJ2			;yes.  double skip return
	CAIN	CHAR,","		;no.  end of project
	JRST	CPOPJ3			;yes.  triple skip return
	CAIN	CHAR,"]"		;no.  end of ppn
	POPJ	P,			;yes.  direct return
	SOJL	C,RFERR1		;no.  file name specification too long?
	TRZ	CHAR,40			;no.  convert char to sixbit
	TRZE	CHAR,100
	TRO	CHAR,40
	IDPB	CHAR,B			;save this sixbit char
	JRST	RFNAME
CPOPJ3:	AOS	(P)
CPOPJ2:	AOS	(P)
	JRST	CPOPJ1

	END	APE